Comparer deux colonnes
je suis à la recherche d'une ame chariatable qui pourra m'aider à resoudre mon Pb.
L'ojectif et de pouvoir comparer deux colonnes (A et B) remplies avec des données provenant de deux sources differentes.
J'aimerai pouvoir comparer les deux colonnes. Mettre en evidence les valeurs de la colonne A qui ne sont pas dans B et inversement, valeurs de B pas dans A.
Mettre en evidence les differences entre les colonnes et ajouter aux les colonnes les manquants pour que colonne A = colonne B
J'ai un bout de code mais il ne fonctionne correctement. Si une valeur existe dans A et pas dans B pas de pb. Idem si existe dans B mais pas dans A.
Le pb commence lorsque la valuer existe dans A et dans B mais son occurence est differente.
Ex: si j'ai 3x la valeur 1959 dans la colonne A et que 2 fois dans la colonne B la macro ne l e voit pas.
Y aurait-il un moyen de verifier cette occurence et dans tenir compte.
Merci
Bonjour,
Essayez ceci
Sub Comp()
Dim Derli_1 As Long, DerLig_2 As Long
Dim D1 As Object, D2 As Object, D3 As Object, D4 As Object, D5 As Object
Application.ScreenUpdating = False
Sheets("Test").Activate
Derlig_1 = Range("A" & Rows.Count).End(xlUp)(1).Row
DerLig_2 = Range("A" & Rows.Count).End(xlUp)(2).Row
Columns("D:F").ClearContents
Set D5 = CreateObject("Scripting.Dictionary")
Set D1 = CreateObject("Scripting.Dictionary")
For Each Item In Range("A2:A" & Derlig_1)
If Item.Text <> "" Then
D1(Item.Text) = ""
Else
D5(Item.Text) = ""
End If
Next
Set D2 = CreateObject("Scripting.Dictionary")
For Each Item In Range("B2:B" & DerLig_2)
If Item.Text <> "" Then
If Not D1.exists(Item.Text) Then
D2(Item.Text) = ""
Else
D5(Item.Text) = ""
End If
End If
Next
If D2.Count > 0 Then
Range("E2").Resize(D2.Count, 1) = Application.Transpose(D2.keys)
Range("E1") = "valeurs manquantes en A"
End If
Set D3 = CreateObject("Scripting.Dictionary")
For Each Item In Range("B2:B" & Derlig_1)
If Item.Text <> "" Then
D3(Item.Text) = ""
Else
D5(Item.Text) = ""
End If
Next
Set D4 = CreateObject("Scripting.Dictionary")
For Each Item In Range("A2:A" & Derlig_1)
If Item.Text <> "" Then
If Not D3.exists(Item.Text) Then
D4(Item.Text) = ""
Else
D5(Item.Text) = ""
End If
End If
Next
If D4.Count > 0 Then
Range("F2").Resize(D4.Count, 1) = Application.Transpose(D4.keys)
Range("F1") = "valeurs manquantes en B"
End If
If D5.Count > 0 Then
Range("D2").Resize(D5.Count, 1) = Application.Transpose(D5.keys)
Range("D1") = "valeurs présentes dans les 2"
End If
Set D1 = Nothing
Set D2 = Nothing
Set D3 = Nothing
Set D4 = Nothing
Set D5 = Nothing
End SubCdlt
Bonjour,
Sans VBA avec Excel 365.
On utilise les nouvelles fonctions (Filtre, Unique et Trier) avec Nb.Si.
Cdlt.
Merci Arturo pour cette réponse.
Je viens de la tester. Le résultat me semble identique à la version précédente.
En sortie, la colonne "A" n'est toujours pas egale a la colonne "B" et inversement.
En exemple, il manque dans B, 1x la valeur 1959, 2x la valeur 12009,...
Il faudrait retrouver dans "F", les valeurs 1x 1959, 2x 12009
Ok, quand il y avait doublons je ne comptait que pour 1, alors je vais revoir ma copie.
Merci Jean-Eric pour ces conseils.
Si jamais je n'arrive pas en m'en sortir avec le vba je reviendaris volontié ves ta solution.
Merci
Cette version vous convient-elle mieux?
Edit:
Puisque vous avez 365, vous pouvez utilisez "Power query", pas de macros , pas de formules, faites des recherches de ce côté là.
Merci beaucoup Arturo pour le temps passé à mon pb.
Je vient de tester. Ça me semble pas mal du tout.
Un grand merci à tous pour votre aide.
Bonn soiree