Microsoft 365 Recherche de manquants entre deux colonnes

[Faroyo]

Bonjour,
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 le voit pas.

Y aurait-il un moyen de verifier cette occurence et dans tenir compte.
Merci

 

[vgendron]

Hello

un bout de code pour comparer tes deux colonnes et identifier les "manquants" d'une colonne à l'autre..
mais. je ne sais pas pourquoi, meme si tu ne l'as pas clairement exprimé, je pressent que ce n'est pas ce dont tu as besoin...

Sub comp2()
Dim tabD1() As Variant
Dim tabD2() As Variant

With Sheets("Test")
    fin = .Range("A" & .Rows.Count).End(xlUp).Row
    tabD1 = .Range("A2:A" & fin).Value
    fin = .Range("B" & .Rows.Count).End(xlUp).Row
    tabD2 = .Range("B2:B" & fin).Value

For i = LBound(tabD1, 1) To UBound(tabD1, 1)
    AinB = False
    For j = LBound(tabD2, 1) To UBound(tabD2, 1)
        If tabD1(i, 1) = tabD2(j, 1) Then
            AinB = True
            Exit For
        End If
        
    Next j
    If AinB Then
        .Range("D" & .Rows.Count).End(xlUp).Offset(1, 0) = tabD1(i, 1)
    Else
        .Range("F" & .Rows.Count).End(xlUp).Offset(1, 0) = tabD1(i, 1)
    End If
Next i
For i = LBound(tabD2, 1) To UBound(tabD2, 1)
    BinA = False
    For j = LBound(tabD1, 1) To UBound(tabD1, 1)
        If tabD2(i, 1) = tabD1(j, 1) Then
            BinA = True
            Exit For
        End If
        
    Next j
    If BinA Then
        '.Range("D" & .Rows.Count).End(xlUp).Offset(1, 0) = tabD1(i, 1) 'cas déjà traité avec la boucle précédente
    Else
        .Range("E" & .Rows.Count).End(xlUp).Offset(1, 0) = tabD2(i, 1)
    End If
Next i
End With
End Sub

 

[Faroyo]

Hello

un bout de code pour comparer tes deux colonnes et identifier les "manquants" d'une colonne à l'autre..
mais. je ne sais pas pourquoi, meme si tu ne l'as pas clairement exprimé, je pressent que ce n'est pas ce dont tu as besoin...

Sub comp2()
Dim tabD1() As Variant
Dim tabD2() As Variant

With Sheets("Test")
    fin = .Range("A" & .Rows.Count).End(xlUp).Row
    tabD1 = .Range("A2:A" & fin).Value
    fin = .Range("B" & .Rows.Count).End(xlUp).Row
    tabD2 = .Range("B2:B" & fin).Value

For i = LBound(tabD1, 1) To UBound(tabD1, 1)
    AinB = False
    For j = LBound(tabD2, 1) To UBound(tabD2, 1)
        If tabD1(i, 1) = tabD2(j, 1) Then
            AinB = True
            Exit For
        End If
       
    Next j
    If AinB Then
        .Range("D" & .Rows.Count).End(xlUp).Offset(1, 0) = tabD1(i, 1)
    Else
        .Range("F" & .Rows.Count).End(xlUp).Offset(1, 0) = tabD1(i, 1)
    End If
Next i
For i = LBound(tabD2, 1) To UBound(tabD2, 1)
    BinA = False
    For j = LBound(tabD1, 1) To UBound(tabD1, 1)
        If tabD2(i, 1) = tabD1(j, 1) Then
            BinA = True
            Exit For
        End If
       
    Next j
    If BinA Then
        '.Range("D" & .Rows.Count).End(xlUp).Offset(1, 0) = tabD1(i, 1) 'cas déjà traité avec la boucle précédente
    Else
        .Range("E" & .Rows.Count).End(xlUp).Offset(1, 0) = tabD2(i, 1)
    End If
Next i
End With
End Sub

Merci pour cette reponse Vgendron mais oui effectivement, bien que fonctionnnanat parfaitement pour rechercher les manquants il resoud pas le pb de l'occurence.

Dans la colonne A j'ai 3x la valeur 1959 mais que 2x dans la colonne B. une occurence de la valeur 1959 est donc manquante dans la colonne B. Il faudrait donc retrouver 1x 1959 dans "F"
Pour la valeur 12009 est presente 5x dans A mais que 3x dans B. Elle devrait donc apparaitre 2x dans F
Volia en gros le pb a resoudre en esperent avoir ete plus clair

Merci

 

[vgendron]

ha ok, c'est pas encore ce que j'avais pensé..
comme j'étais parti sur autre chose, je te livre quand meme la solution que j'avais:
je croyais que tu allais finir par demander d'inserer les éléments manquants d'une colonne à l'autre pour que les deux soient strictement identiques au final: ce qui donnait ca

Sub Comp3()
Application.ScreenUpdating = False
With Sheets("Test")
    fin = .UsedRange.Rows.Count
    For i = 2 To fin
        If .Range("A" & i) <> .Range("B" & i) Then
            If .Range("A" & i) < .Range("B" & i) Then
                .Range("B" & i).Insert shift:=xlDown 'on insère une ligne pour la donnée manquante
                fin = fin + 1
            Else
                .Range("A" & i).Insert shift:=xlDown 'on insère une ligne pour la donnée manquante
                fin = fin + 1
            End If
        End If
    Next i
    For i = 2 To fin
        If .Range("A" & i) = "" Then
            '.Range("A" & i) = .Range("B" & i) 'on complète la colonne
            .Range("E" & .Rows.Count).End(xlUp).Offset(1, 0) = .Range("B" & i)
        End If
        If .Range("B" & i) = "" Then
            '.Range("B" & i) = .Range("A" & i) 'on complète la colonne
            .Range("F" & .Rows.Count).End(xlUp).Offset(1, 0) = .Range("A" & i)
        End If
    Next i
End With
Application.ScreenUpdating = True
End Sub

 

[Faroyo]

Je vois que tu as parfaitement compris le fond de ma pensee, ton code est nickel et oui effectivement si tu pouvais inserer les manaquants ce serait juste parfait.

merci

 

[vgendron]

dans ce cas, il te suffit de decommenter les deux lignes 'on complète la colonne

 

[Hasco]

bonjour,

Une proposition par power query.

Bien-sûr on peut tout faire ou modifier ou presque.

Cordialement

 

[Faroyo]

C'est juste parfait. Merci beaucoup pour votre aide.
Bonne fin de journee.

HM

 

[vgendron]

et pour le fun une solution à base de dictionaire pour juste donner les manquants SANS modifier les colonnes de départ

Sub Comp4()

Set dicoD1 = CreateObject("Scripting.Dictionary")
Set dicoD2 = CreateObject("Scripting.Dictionary")

With ActiveSheet
    fin = .Range("A" & .Rows.Count).End(xlUp).Row
    For i = 2 To fin
        clé = .Range("A" & i)
        If Not dicoD1.Exists(clé) Then
            dicoD1.Add clé, 1
        Else
            dicoD1(clé) = dicoD1(clé) + 1
        End If
    Next i
    
    fin = .Range("B" & .Rows.Count).End(xlUp).Row
    For i = 2 To fin
        clé = .Range("B" & i)
        If Not dicoD2.Exists(clé) Then
            dicoD2.Add clé, 1
        Else
            dicoD2(clé) = dicoD2(clé) + 1
        End If
    Next i
    For Each clé In dicoD1.Keys
        If dicoD2.Exists(clé) Then
            If dicoD1(clé) <> dicoD2(clé) Then
                If dicoD1(clé) > dicoD2(clé) Then
                    .Range("F" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(dicoD1(clé) - dicoD2(clé)) = clé
                Else
                    .Range("E" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(dicoD2(clé) - dicoD1(clé)) = clé
                End If
            End If
        Else
            .Range("F" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(dicoD1(clé)) = clé
        
        End If
    Next clé
    For Each clé In dicoD2.Keys
        If dicoD1.Exists(clé) Then
            If dicoD1(clé) <> dicoD2(clé) Then
                If dicoD1(clé) > dicoD2(clé) Then
                    '.Range("F" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(dicoD1(clé) - dicoD2(clé)) = clé 'déjà traité dans la boucle précédente
                Else
                    .Range("E" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(dicoD2(clé) - dicoD1(clé)) = clé
                End If
            End If
        Else
            .Range("E" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(dicoD2(clé)) = clé
        
        End If
    Next clé
End With

End Sub

 

[Faroyo]

Merci Vgendron. Je me garde cette derniere solution sous le coude, on ne sait jamais.

Merci beaucoup.

 

[job75]

Bonjour Faroyo, vgendron, Roblochon,

Voyez le fichier joint et cette macro :

Sub Comparer()
Dim d As Object, P As Range, Q As Range, c As Range
Set d = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
With ActiveSheet 'à adapter
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    Set P = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
    Set Q = .Range("B2", .Range("B" & .Rows.Count).End(xlUp))
    For Each c In P
        d(c.Value) = d(c.Value) + 1
        c = c & "|" & d(c.Value) 'ajoute la fréquence cumulée
    Next
    d.RemoveAll 'RAZ
    For Each c In Q
        d(c.Value) = d(c.Value) + 1
        c = c & "|" & d(c.Value) 'ajoute la fréquence cumulée
    Next
    Q.Copy P(P.Count + 1)
    With P(P.Count + 1).Resize(Q.Count)
        .Interior.ColorIndex = 6 'cellules ajoutées en jaune
        .EntireColumn.RemoveDuplicates 1, Header:=xlYes 'supprime les doublons
    End With
    P.Copy Q(Q.Count + 1)
    With Q(Q.Count + 1).Resize(P.Count)
        .Interior.ColorIndex = 6 'cellules ajoutées en jaune
        .EntireColumn.RemoveDuplicates 1, Header:=xlYes 'supprime les doublons
    End With
    Union(P, Q).EntireColumn.Replace "|*", "", xlPart 'RAZ
    .Rows.AutoFit 'ajuste les hauteurs'
End With
End Sub

Les cellules ajoutées dans chaque colonne sont en jaune en bas du tableau.

A+

 

[Faroyo]

C'est super simpa de me proposer ces différentes solutions. En tant que novice en la matière je vais me faire un plaisir d'étudier vos codes et d'apprendre de nouvelles approches grace à vous.

Merci à vous tous.
Faroyo