Rechercher, sélectionner et remplacer - VB / VBA

Rechercher, sélectionner et remplacer Recherche code pour remplacer des valeurs par vba sous condition (Résolu) » Forum - VB / VBA Recherche un logiciel remplaçant la souris (Résolu) » Forum - Handicap / Accessibilté Recherche moyen de remplacer INTEL PRO/100 après install Win 7 (Résolu) » Forum - Réseau Recherche pilotes de remplacement (Résolu) » Forum - Windows Le moteur de recherche Ask a remplacé GOOGLE CHROME » Forum - Virus / Sécurité

Bonjour a tous,

J’ai deux userform dans mon premier onglet (Formulaire). Le premier userform sert à entrer de nouvelles données qui alimente une bdd sur un second onglet (Activités).
Le deuxième permet aux utilisateurs de taper un num d’ID sur la première ligne correspondant aux lignes de ma BDD afin d’afficher les données déjà saisies auparavant et pouvoir les mettre à jour si nécessaire.



Actuellement en cliquant sur METTRE À JOUR sur le deuxième userform, la macro mise en place crée une ligne supplémentaire dans la BDD.

Ce que je souhaiterais actuellement, c’est qu’a la place de générer une ligne supplémentaire dans ma BDD je souhaiterais que les données précédentes soient écrasées par les nouvelles ce qui me permettrais de toujours conserver qu’une seule ligne par num d’ID.

En espérant que vous pourrez m’aider voilà mon code:

Sub TransposeBDD() 
Dim TInfos, PCV

Application.ScreenUpdating = False

'mémoriser les données
TInfos = Sheets("Formulaire").Range("G12:G26")
'--------------------Ecriture des donnees----------------------
With Worksheets("Activités")
PCV = .Range("A" & Rows.Count).End(xlUp).Row + 1 'premier cellule vide colonne A
If PCV < 2 Then PCV = 2
.Range("A" & PCV & ":D" & PCV) = Application.Transpose(Sheets("Formulaire").Range("G12:G15"))
.Range("F" & PCV & ":P" & PCV) = Application.Transpose(Sheets("Formulaire").Range("G16:G26"))
End With
'----------------------------------------------------------------------
'Rendre vierge le formulaire
With Sheets("Formulaire")
.Select
.Range("G13:G26").ClearContents
.Range("G12").Select
End With
Sheets("Activités").Select
Columns("A:A").Select
ActiveWorkbook.Worksheets("Activités").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Activités").AutoFilter.Sort.SortFields.Add Key:= _
Range("A2:A1000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("Activités").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A2").Select
Sheets("Formulaire").Select
Range("G14").Select

Application.ScreenUpdating = True

End Sub

Sub MAJBDD()
Dim TInfos, PCV

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'mémoriser les données
TInfos = Sheets("Formulaire").Range("M12:M26")
'--------------------Ecriture des donnees----------------------
With Worksheets("Activités")
PCV = .Range("A" & Rows.Count).End(xlUp).Row + 1 'premier cellule vide colonne A
If PCV < 2 Then PCV = 2
.Range("A" & PCV & ":D" & PCV) = Application.Transpose(Sheets("Formulaire").Range("M12:M15"))
.Range("F" & PCV & ":P" & PCV) = Application.Transpose(Sheets("Formulaire").Range("M16:M26"))
End With
'----------------------------------------------------------------------
'Rendre vierge le formulaire
With Sheets("Formulaire")
.Select
.Range("M12:M13").ClearContents
.Range("M13").Select
ActiveCell.FormulaArray = _
"=MAX(IF(R[-1]C=Activités!R[-11]C[-12]:R[987]C[-12],Activités!R[-11]C[-11]:R[987]C[-11],""""))"
Range("M14").Select
Selection.FormulaArray = _
"=INDEX(Activités!R[-12]C[-10]:R[986]C[-10],MATCH(MAX(IF(Formulaire!R[-2]C=Activités!R[-12]C[-12]:R[986]C[-12],Activités!R[-12]C[-11]:R[986]C[-11],""""))&Formulaire!R[-2]C,Activités!R[-12]C[-11]:R[986]C[-11]&Activités!R[-12]C[-12]:R[986]C[-12],0))"
Range("M15").Select
Selection.FormulaArray = _
"=INDEX(Activités!R[-13]C[-9]:R[985]C[-9],MATCH(MAX(IF(Formulaire!R[-3]C=Activités!R[-13]C[-12]:R[985]C[-12],Activités!R[-13]C[-11]:R[985]C[-11],""""))&Formulaire!R[-3]C,Activités!R[-13]C[-11]:R[985]C[-11]&Activités!R[-13]C[-12]:R[985]C[-12],0))"
Range("M16").Select
Selection.FormulaArray = _
"=INDEX(Activités!R[-14]C[-7]:R[984]C[-7],MATCH(MAX(IF(Formulaire!R[-4]C=Activités!R[-14]C[-12]:R[984]C[-12],Activités!R[-14]C[-11]:R[984]C[-11],""""))&Formulaire!R[-4]C,Activités!R[-14]C[-11]:R[984]C[-11]&Activités!R[-14]C[-12]:R[984]C[-12],0))"
Range("M17").Select
Selection.FormulaArray = _
"=INDEX(Activités!R[-15]C[-6]:R[983]C[-6],MATCH(MAX(IF(Formulaire!R[-5]C=Activités!R[-15]C[-12]:R[983]C[-12],Activités!R[-15]C[-11]:R[983]C[-11],""""))&Formulaire!R[-5]C,Activités!R[-15]C[-11]:R[983]C[-11]&Activités!R[-15]C[-12]:R[983]C[-12],0))"
Range("M18").Select
ActiveCell.FormulaArray = _
"=INDEX(Activités!R[-16]C[-5]:R[982]C[-5],MATCH(MAX(IF(Formulaire!R[-6]C=Activités!R[-16]C[-12]:R[982]C[-12],Activités!R[-16]C[-11]:R[982]C[-11],""""))&Formulaire!R[-6]C,Activités!R[-16]C[-11]:R[982]C[-11]&Activités!R[-16]C[-12]:R[982]C[-12],0))"
Range("M19").Select
ActiveCell.FormulaArray = _
"=INDEX(Activités!R[-17]C[-4]:R[981]C[-4],MATCH(MAX(IF(Formulaire!R[-7]C=Activités!R[-17]C[-12]:R[981]C[-12],Activités!R[-17]C[-11]:R[981]C[-11],""""))&Formulaire!R[-7]C,Activités!R[-17]C[-11]:R[981]C[-11]&Activités!R[-17]C[-12]:R[981]C[-12],0))"
Range("M20").Select
ActiveCell.FormulaArray = _
"=INDEX(Activités!R[-18]C[-3]:R[980]C[-3],MATCH(MAX(IF(Formulaire!R[-8]C=Activités!R[-18]C[-12]:R[980]C[-12],Activités!R[-18]C[-11]:R[980]C[-11],""""))&Formulaire!R[-8]C,Activités!R[-18]C[-11]:R[980]C[-11]&Activités!R[-18]C[-12]:R[980]C[-12],0))"
Range("M21").Select
Selection.FormulaArray = _
"=INDEX(Activités!R[-19]C[-2]:R[979]C[-2],MATCH(MAX(IF(Formulaire!R[-9]C=Activités!R[-19]C[-12]:R[979]C[-12],Activités!R[-19]C[-11]:R[979]C[-11],""""))&Formulaire!R[-9]C,Activités!R[-19]C[-11]:R[979]C[-11]&Activités!R[-19]C[-12]:R[979]C[-12],0))"
Range("M22").Select
Selection.FormulaArray = _
"=INDEX(Activités!R[-20]C[-1]:R[978]C[-1],MATCH(MAX(IF(Formulaire!R[-10]C=Activités!R[-20]C[-12]:R[978]C[-12],Activités!R[-20]C[-11]:R[978]C[-11],""""))&Formulaire!R[-10]C,Activités!R[-20]C[-11]:R[978]C[-11]&Activités!R[-20]C[-12]:R[978]C[-12],0))"
Range("M23").Select
Selection.FormulaArray = _
"=INDEX(Activités!R[-21]C:R[977]C,MATCH(MAX(IF(Formulaire!R[-11]C=Activités!R[-21]C[-12]:R[977]C[-12],Activités!R[-21]C[-11]:R[977]C[-11],""""))&Formulaire!R[-11]C,Activités!R[-21]C[-11]:R[977]C[-11]&Activités!R[-21]C[-12]:R[977]C[-12],0))"
Range("M24").Select
Selection.FormulaArray = _
"=INDEX(Activités!R[-22]C[1]:R[976]C[1],MATCH(MAX(IF(Formulaire!R[-12]C=Activités!R[-22]C[-12]:R[976]C[-12],Activités!R[-22]C[-11]:R[976]C[-11],""""))&Formulaire!R[-12]C,Activités!R[-22]C[-11]:R[976]C[-11]&Activités!R[-22]C[-12]:R[976]C[-12],0))"
Range("M25").Select
Selection.FormulaArray = _
"=INDEX(Activités!R[-23]C[2]:R[975]C[2],MATCH(MAX(IF(Formulaire!R[-13]C=Activités!R[-23]C[-12]:R[975]C[-12],Activités!R[-23]C[-11]:R[975]C[-11],""""))&Formulaire!R[-13]C,Activités!R[-23]C[-11]:R[975]C[-11]&Activités!R[-23]C[-12]:R[975]C[-12],0))"
Range("M26").Select
Selection.FormulaArray = _
"=INDEX(Activités!R[-24]C[3]:R[974]C[3],MATCH(MAX(IF(Formulaire!R[-14]C=Activités!R[-24]C[-12]:R[974]C[-12],Activités!R[-24]C[-11]:R[974]C[-11],""""))&Formulaire!R[-14]C,Activités!R[-24]C[-11]:R[974]C[-11]&Activités!R[-24]C[-12]:R[974]C[-12],0))"
.Range("M12").Select
End With
Sheets("Activités").Select
Columns("A:A").Select
ActiveWorkbook.Worksheets("Activités").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Activités").AutoFilter.Sort.SortFields.Add Key:= _
Range("A2:A1000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("Activités").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A2").Select
Sheets("Formulaire").Select
Range("G14").Select

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub


Merci

Forum

Rechercher, sélectionner et remplacer Recherche code pour remplacer des valeurs par vba sous condition (Résolu) » Forum - VB / VBA Recherche un logiciel remplaçant la souris (Résolu) » Forum - Handicap / Accessibilté Recherche moyen de remplacer INTEL PRO/100 après install Win 7 (Résolu) » Forum - Réseau Recherche pilotes de remplacement (Résolu) » Forum - Windows Le moteur de recherche Ask a remplacé GOOGLE CHROME » Forum - Virus / Sécurité

Web: www.shapebootstrap.net

23 réponses

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

Bonjour,

une seule ligne par num d’ID
Je suppose que lorsque vous entrez l'ID, vous faites une recherche de la ligne ou se trouvent les infos. Donc vous pouvez reecrire les nouvelles info sur cette ligne puisque vous l'avez.......

Reply
réponses:
  • auteur

  • Xenos1705

    Les infos remontent grâce à des formules matricielles inscrites dans les cases du userform

    Ce que je cherche c’est remplacer les données dans la base de données lorsque j’appuye Sur mettre à jour. La macro devrait copier l’integralité des données du userform par un transpose sur la ligne existante dans la BDD

    Je ne sais pas comment écrire ce code.

    Il s’agit de cette partie de mon code:

    Sub MAJBDD() 
    Dim TInfos, PCV

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    'mémoriser les données
    TInfos = Sheets("Formulaire").Range("M12:M26")
    '--------------------Ecriture des donnees----------------------
    With Worksheets("Activités")
    PCV = .Range("A" & Rows.Count).End(xlUp).Row + 1 'premier cellule vide colonne A
    If PCV < 2 Then PCV = 2
    .Range("A" & PCV & ":D" & PCV) = Application.Transpose(Sheets("Formulaire").Range("M12:M15"))
    .Range("F" & PCV & ":P" & PCV) = Application.Transpose(Sheets("Formulaire").Range("M16:M26"))
    End With

  • f894009

    Re,

    dans les cases du userform

    Y a pas de userform.... Ce sont des cellules

    sur la ligne existante dans la BDD
    Oui, comme je vous l'ai ecrit....
    Question: quand vous entrez l'ID, le deuxieme tableau de cellules se remplit avec les infos de' l'ID ????

  • Xenos1705

    Oui des cellules.

    Non, il faut inscrire le num ID souhaité sur la première cellule du deuxième tableau. Ensuite si ce num ID existe dans la BDD, les éléments correspondants s’affichent dans les cellules.
    Le premier tableau n’est utilisé que pour inséré de nouvelles données avec un nouvel ID.

    J’espère être plus clair. Merci pour vos réponses

  • f894009

    Re,
    Ensuite si ce num ID existe dans la BDD
    Ben oui, c'est ce que j'ai suppose. Si vous avez ete capable de recuperer les infos de l'ID dans la BDD, c'est que vous avez trouvez la ligne de c'est infos, donc si vous la mettez en memoire vous pourrez reecrire les infos de l'ID sur cette ligne

  • Xenos1705

    Merci beaucoup pour vos réponses mais malheureusement je n’ai pas à mon avis les connaissances nécessaires pour mettre en place votre solution.

    Je ne vois pas du tout comment adapter mon code malheureusement, j’ai pourtant essayé différentes façons mais sans succès.

    C’est pour cela que j’ai fais recours au forum, pour que quelqu’un ait bien l’amabilité de m’aider.

  • f894009

    Bonjour,

    Le remplissage des cellules se fait par du code VBA ou des formules (autre possibilité )??

  • Xenos1705

    Bonjour,

    Une fois la BDD mise à jour, la macro vide le formulaire, et renseigne à nouveaux les formules dans les cellules via VBA.

    Les formules sont celles qui commencent par INDEX dans mon code.

    Encore merci et bonne journée

  • f894009

    Re,
    Ok, je regarde la chose

    vous pouvez mettre votre fichier a dispo

    Pour transmettre un fichier,
    Veillez a ce qu'il n'y ait PAS DE DONNEES CONFIDENTIELLES
    il faut passer par un site de pièce jointe tel que cjoint.com

    Allez sur ce site : http://cjoint.com
    Clic sur parcourir,
    Cherche ton fichier,
    clic sur ouvrir,
    Clic sur "Créer le lien cjoint",
    Copier le lien,
    Revenir ici le coller dans une réponse...

    ou
    'mon partage
    https://mon-partage.fr/

    ou
    www.transfernow.net 'fichier jusqu'a 4G
    A+

  • Xenos1705

    Hello,

    Désolé pour le retard mais pour des soucis de confidentialité j'ai du recréer le fichier qui est du coup plus simplifié mais l'essentiel y est. Pour info, le userform correspond à un calendrier que je n'ai pas mis en place de ce fichier.

    Voilà le lien pour le fichier:
    https://1fichier.com/?0yhjoltya2

    Encore merci pour votre aide.

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

Bonjour,

"Formulaire" mise a jour, pas de formule puisque vous modifiez une ou plusieurs valeurs, donc formule(s) effacee(s). Faire la recherche des infos par du VBA

Pourquoi pas avoir des Userform pour vos "formulaires" ??????????????????????????????????????????

Reply
réponses:
  • Xenos1705

    Malheureusement je fais avec les connaissances que j’ai. Et je ne connais pas toutes les possibilités, d’ou ma demande à l’aide. Si l’usage de userform est plus simple, efficace et approprié j’y opterais sans hésitation.

  • f894009

    Re,

    Je vous fait ca
    A+

  • Xenos1705

    Merci beaucoup :-)

  • f894009

    Bonjour,
    Ne vous inquiétez pas j'ai bientôt fini

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

Bon jour,

Les cellules Team et Charge ont des nombres entiers ou decimaux ???????

Reply
réponses:
  • auteur

  • Xenos1705

    Bonjour,

    Les cellules Team sont des nombres entiers par contre la charge sont des nombres à deux décimales.

    Merci :-)

  • f894009

    Re,
    Ok, suis un peu q la ramasse mais ca avance....

    Pour valider, faut-il que toutes les cases soient remplies ou quelles sont les cases obligatoires ?

  • Xenos1705

    Alors oui effectivement toutes les cases doivent être remplies sinon y a le message d’erreur qui apparaît informant que toutes les cellules doivent être remplies avant de pouvoir enregistrer ou mettre à jour.

    Moi qui pensais qu’il suffisait de changer une ligne de code, je suis à côté de la plaque

  • f894009

    Bonjour,

    Moi qui pensais qu’il suffisait de changer une ligne de code, je suis à côté de la plaque
    Pas vraiment.Vous verrez ce qu'il faut (disons a minima) pour que ca donne un resultat acceptable

  • f894009

    Re,

    un exemple de programmation:
    Ouverture UF par bouton sur feuille Formulaire

    https://mon-partage.fr/f/ygFKYS4v/

  • f894009

    Re,
    Petit oubli, pour un nouvel ID a l'ouverture de l'UF laissez liste de choix vide. Je vais ajouter un bouton a l'UF pour pourvoir ajouter un ID sans avoir a fermer l'UF a la suite d'un ajout ou d'une modif

  • f894009

    Bonjour,

    UF avec boutons Nouvel ID et Quitter: https://mon-partage.fr/f/5KgKqvaY/
    Pour les couleurs a vous de voir

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed