Discussion :

[Paclxl]

Bonjour à tous,

Premier message sur le forum, je suis sans doute passé à coté de la réponse mais je n'ai pas trouvé le moyen de faire cette opération:

J'ai 2 colonnes de texte que je souhaite comparer :

AA AA
BB CC
CC DD
DD EE
EE

la valeur BB n'est plus présente et je souhaiterai soit la rajouter à la fin de la plage (je l'analyse avec le reste de ma macro) soit récupérer le delta entre la position dans la colonne (2) et le nombre de valeur dans la colonne (ici 5 mais cela peut être variable) pour l'utiliser ensuite dans ma macro, cette version serait ma préférée.

Merci d'avance pour votre aide
P.

[ARTURO83]

Bonjour,

Proposition, extrait les valeurs uniques des colonnes A et B et donne les positions respectives.

Paclxl_comparer 2 plages de valeurs et extraires les manquants.xlsm

le code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
Option Explicit
 
Sub Comparer()
    Dim D1 As Object, D2 As Object
    Dim V1 As Range, V2 As Range
    Dim DerLig_A As Long, DerLig_B As Long
    Application.ScreenUpdating = False
    DerLig_A = Range("A" & Rows.Count).End(xlUp).Row 'nombre de lignes = nombre de valeurs de la colonne A
    DerLig_B = Range("B" & Rows.Count).End(xlUp).Row 'nombre de lignes = nombre de valeurs de la colonne B
 
    Range("C2:I100000").ClearContents
    'recherche des valeurs présentes en colonne A et manquantes en colonne B
    Set D1 = CreateObject("Scripting.Dictionary")
    For Each V1 In Range("B2:B" & DerLig_A)
        If V1.Text <> "" Then D1(V1.Text) = ""
    Next
    Set D2 = CreateObject("Scripting.Dictionary")
    For Each V2 In Range("A2:A" & DerLig_B)
        If V2.Text <> "" Then
            If Not D1.exists(V2.Text) Then D2(V2.Text) = ""
        End If
    Next
    If D2.Count > 0 Then
        Range("C2").Resize(D2.Count, 1) = Application.Transpose(D2.keys)
        Range(Cells(2, "D"), Cells(D2.Count + 1, "D")).FormulaR1C1 = "=MATCH(RC3,C1,0)-1"
        Cells(2, "E").FormulaR1C1 = "=COUNTA(C1)-1"
    End If
    D1.RemoveAll
    D2.RemoveAll
 
    'recherche des valeurs présentes en colonne B et manquantes en colonne A
    Set D1 = CreateObject("Scripting.Dictionary")
    For Each V1 In Range("A2:A" & DerLig_A)
        If V1.Text <> "" Then D1(V1.Text) = ""
    Next
    Set D2 = CreateObject("Scripting.Dictionary")
    For Each V2 In Range("B2:B" & DerLig_B)
        If V2.Text <> "" Then
            If Not D1.exists(V2.Text) Then D2(V2.Text) = ""
        End If
    Next
    If D2.Count > 0 Then
        Range("G2").Resize(D2.Count, 1) = Application.Transpose(D2.keys)
        Range(Cells(2, "H"), Cells(D2.Count + 1, "H")).FormulaR1C1 = "=MATCH(RC7,C2,0)-1"
        Cells(2, "I").FormulaR1C1 = "=COUNTA(C2)-1"
    End If
    Set D1 = Nothing
    Set D2 = Nothing
End Sub

Cdlt

[Paclxl]

Merci beaucoup Arturo83, je vais maintenant regarder pour l'intégrer dans ma macro.

Bonne journée