XL 2013 Comparaison de bases de données

Luc MOUNY · 11 Novembre 2019

Bonjour à tous,
J'ai beaucoup cherché, mais je n'ai rien trouvé de concluant.
Je possède une base de données de 2200 lignes, Je ne sais par quelle erreur de manipulation, une grande quantité des professions des adhérents, en colonne M est disparue.
Je possède une ancienne base où figurent les professions.

Mon souci, est qu'un certain nombre d'adhérents sont sortis de la base : par démission décès ou autre. Par contre un certain nombre d'adhérents nouveaux a fait son entrée dans la base. Donc le copier coller n'est guère envisageable, pas plus que l'entrée manuelle des professions.

Est-il possible par macro, de comparer les deux bases, se situant dans le même dossier et dans deux feuilles différentes, et de rapatrier les professions, en tenant compte du nom et du prénom des adhérents ?
Je joins un fichier anonymisé, comportant une base actuelle, et une ancienne base, pour imager mon propos.

Merci d'avance aux spécialistes d'Excel-Download qui voudront bien se pencher sur mon problème.

Luc

mapomme · 11 Novembre 2019

Bonsoir @Luc MOUNY,

Voir le fichier joint:

Dans l’ancienne base, on utilise une colonne auxiliaire (colonne T) avec la formule suivante en T2 à recopier vers le bas: =C2&"/"&D2

Dans la base actuelle, dans la colonne T, on a la formule suivante en T2 à recopier vers le bas:
=SIERREUR(SI(S2<>"";S2;INDEX(Base2!S:S;EQUIV(C2&"/"&D2;Base2!T:T;0)));"")

mapomme · 11 Novembre 2019

Re,

Avec une macro. Cliquez sur le bouton Hop!

Le code dans module1:

Code:

Sub Profession()
Dim t1, t2, n1, n2, dico2, i&, clef

With Sheets("base")
   n1 = .Range("c1:d" & .Cells(.Rows.Count, "a").End(xlUp).Row)
   t1 = .Range("s1:s" & .Cells(.Rows.Count, "a").End(xlUp).Row)
   With Sheets("base2")
      n2 = .Range("c1:d" & .Cells(.Rows.Count, "a").End(xlUp).Row)
      t2 = .Range("s1:s" & .Cells(.Rows.Count, "a").End(xlUp).Row)
   End With
   Set dico2 = CreateObject("scripting.dictionary")
   dico2.CompareMode = TextCompare
   For i = 2 To UBound(n2)
      clef = Join(Array(n2(i, 1), n2(i, 2)), "\")
      dico2(clef) = t2(i, 1)
   Next i
   For i = 2 To UBound(n1)
      clef = Join(Array(n1(i, 1), n1(i, 2)), "\")
      If t1(i, 1) = "" Then t1(i, 1) = IIf(dico2.Exists(clef), dico2(clef), ""))
   Next i
   .Range("s1:s" & .Cells(.Rows.Count, "a").End(xlUp).Row) = t1
End With
End Sub

Luc MOUNY · 11 Novembre 2019

mapomme à dit:
Bonsoir @Luc MOUNY,

Voir le fichier joint:

Dans l’ancienne base, on utilise une colonne auxiliaire (colonne T) avec la formule suivante en T2 à recopier vers le bas: =C2&"/"&D2

Dans la base actuelle, dans la colonne T, on a la formule suivante en T2 à recopier vers le bas:
=SIERREUR(SI(S2<>"";S2;INDEX(Base2!S:S;EQUIV(C2&"/"&D2;Base2!T:T;0)));"")

Bonsoir Mapomme, bonsoir à tous le forum.

Un double merci pour la rapidité et la pertinence de votre réponse. Je pensais, et j'ai cherché toute la journée une macro qui ferait exactement la même chose. A aucun moment je n'ai pensé à une formule EXCEL.

Je me voyais mal, parcourir l'ancienne base, et ajouter manuellement les professions manquantes.

Une fois que j'aurai tiré la formule vers le bas sur la colonne auxiliaire, il ne me restera plus qu'à copier et faire collage spécial Valeur, pour faire disparaitre les formules de ma bases de données.

Vous êtes tous supers sur Excel-Download.

A une prochaine fois

mapomme à dit:

Re,

Avec une macro. Cliquez sur le bouton Hop!

Le code dans module1:

Code:

Sub Profession()
Dim t1, t2, n1, n2, dico2, i&, clef

With Sheets("base")
   n1 = .Range("c1:d" & .Cells(.Rows.Count, "a").End(xlUp).Row)
   t1 = .Range("s1:s" & .Cells(.Rows.Count, "a").End(xlUp).Row)
   With Sheets("base2")
      n2 = .Range("c1:d" & .Cells(.Rows.Count, "a").End(xlUp).Row)
      t2 = .Range("s1:s" & .Cells(.Rows.Count, "a").End(xlUp).Row)
   End With
   Set dico2 = CreateObject("scripting.dictionary")
   dico2.CompareMode = TextCompare
   For i = 2 To UBound(n2)
      clef = Join(Array(n2(i, 1), n2(i, 2)), "\")
      dico2(clef) = t2(i, 1)
   Next i
   For i = 2 To UBound(n1)
      clef = Join(Array(n1(i, 1), n1(i, 2)), "\")
      If t1(i, 1) = "" Then t1(i, 1) = IIf(dico2.Exists(clef), dico2(clef), ""))
   Next i
   .Range("s1:s" & .Cells(.Rows.Count, "a").End(xlUp).Row) = t1
End With
End Sub

XL 2013 Comparaison de bases de données

Luc MOUNY

XLDnaute Junior

Pièces jointes

mapomme

XLDnaute Barbatruc

Pièces jointes

mapomme

XLDnaute Barbatruc

Pièces jointes

Luc MOUNY

XLDnaute Junior

Discussions similaires