Microsoft 365 Recherche de manquants entre deux colonnes

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

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

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