Rechercher, sélectionner et remplacer

Xenos1705 -  
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

3 réponses

  1.  f894009
    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.......
    1. Xenos1705 Auteur
      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
    2.  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 ????
    3. Xenos1705 Auteur
      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
    4. 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
    5. Xenos1705 Auteur
      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.
  2. f894009
    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" ??????????????????????????????????????????
    1. Xenos1705 Auteur
      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.
    2. f894009
      Re,

      Je vous fait ca
      A+
    3. Xenos1705 Auteur
      Merci beaucoup :-)
    4. f894009
      Bonjour,
      Ne vous inquiétez pas j'ai bientôt fini
  3. f894009
    Bon jour,

    Les cellules Team et Charge ont des nombres entiers ou decimaux ???????
    1. Xenos1705 Auteur
      Bonjour,

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

      Merci :-)
    2. 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 ?
    3. Xenos1705 Auteur
      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
    4. 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
    5. f894009
      Re,

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

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

Discussions similaires

RETROUVER VENDEUR Sur le bon coin
PTM_026

4 réponses
Le bon coin, comment retrouver un pseudonyme ?
HYPERSENSIBLE

8 réponses