Comparaison des valeurs de deux colonnes

Compare les colonnes A et B

Attention : il ne doit pas y avoir de solution de continuité dans les colonnes A et B
Les colonnes doivent être remplies dès la ligne 1.

Par exemple on part de ça :

aa  
bc  
cd  

Et on obtient ceci :

ABDans A
mais pas dans B
Dans B
mais pas dans A
aabd
bc
cd
Sub LancerComparaison()
Dim FinA, FinB, colA, colB, colDans_A_Pas_Dans_B, colDans_B_Pas_Dans_A
Dim Reponse
'Colonne A
    colA = 1
    FinA = DetermineDerniereLigne(1)
'Colonne B
    colB = 2
    FinB = DetermineDerniereLigne(2)
'colDans_A_Pas_Dans_B : les elements de A qui ne sont pas dans B
    colDans_A_Pas_Dans_B = 3
'colDans_B_Pas_Dans_A : les elements de B qui ne sont pas dans A
    colDans_B_Pas_Dans_A = 4
    Call ComparerColA_A_ColB(FinA, FinB, colA, colB, colDans_A_Pas_Dans_B, colDans_B_Pas_Dans_A)
    Call InsererLigneTitre
	Reponse = MsgBox("Fini !", vbExclamation)
End Sub
Sub ComparerColA_A_ColB(LigneFinA, LigneFinB, colA, colB, colDans_A_Pas_Dans_B, colDans_B_Pas_Dans_A)
    Dim JaiTrouve
    JaiTrouve = True
    Dim CelluleA, CelluleB
    Dim LigneDepart
    LigneDepart = 1
    'Cells(1, 1) = colonne A
    'Cells(1, 2) = colonne B
    For Each CelluleA In ActiveSheet.Range(Cells(1, colA), Cells(LigneFinA, colA))
        For Each CelluleB In ActiveSheet.Range(Cells(1, colB), Cells(LigneFinB, colB))
            If CelluleA = CelluleB Then
                JaiTrouve = True
                Exit For
            End If
            JaiTrouve = False
        Next
        If JaiTrouve = False Then
            JaiTrouve = True
            ActiveSheet.Cells(LigneDepart, colDans_A_Pas_Dans_B).Value = CelluleA.Value
            LigneDepart = LigneDepart + 1
        End If
    Next
    'On passe a la comparaison inverse
    LigneDepart = 1
        For Each CelluleB In ActiveSheet.Range(Cells(1, colB), Cells(LigneFinB, colB))
            For Each CelluleA In ActiveSheet.Range(Cells(1, colA), Cells(LigneFinA, colA))
                If CelluleB = CelluleA Then
                    JaiTrouve = True
                    Exit For
                End If
                JaiTrouve = False
            Next
            If JaiTrouve = False Then
                JaiTrouve = True
                ActiveSheet.Cells(LigneDepart, colDans_B_Pas_Dans_A).Value = CelluleB.Value
                LigneDepart = LigneDepart + 1
            End If
        Next
End Sub
Function DetermineDerniereLigne(Colonne As Integer)
    Dim ligneFin
    ligneFin = 1
    Do While Not IsEmpty(ActiveSheet.Cells(ligneFin, Colonne))
        ligneFin = ligneFin + 1
    Loop
    DetermineDerniereLigne = ligneFin - 1
End Function
Sub InsererLigneTitre()
    ActiveSheet.Rows(1).EntireRow.Insert
    ActiveSheet.Rows(1).RowHeight = 28
    ActiveSheet.Cells(1, 1).Value = "A"
    ActiveSheet.Cells(1, 2).Value = "B"
    ActiveSheet.Cells(1, 3).Value = "Dans A mais pas dans B"
    ActiveSheet.Cells(1, 4).Value = "Dans B mais pas dans A"
    With Range(Cells(1, 1), Cells(1, 4))
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .WrapText = True
    End With
End Sub

Application 1 : récolement

Peut être utile pour le récolement : on met dans la colonne A ce qu'il y a théoriquement sur les rayons, et dans la colonne B ce qu'on a réellement trouvé.
Après application de la macro, la colonne C contiendra ce qui est dans A, mais pas dans B (les lacunes), et la colonne D contiendra ce qu'il y a dans B mais pas dans A (les en-trop).

Dans le catalogueEn rayonsLacunes pas en rayonsPas dans le catalogue
aabd
bc
cd

Les deux colonnes à comparer sont A et B.

Dim maxA As Integer
Dim maxB As Integer
Dim plageB As String
Dim plageA As String

Sub CompterLignes()
	Range("B1").Select
	Selection.End(xlDown).Select
	maxB = Selection.Row
	Range("A1").Select
	Selection.End(xlDown).Select
	maxA = Selection.Row
	ComparerBaA
	ComparerAaB
End Sub

Sub ComparerBaA()
	For b = 1 To maxB
		plageB = "B" & b
		Range(plageB).Select
		For a = 1 To maxA
			plageA = "A" & a
			If Range(plageA).Value <> Range(plageB).Value Then
				If a = maxA Then
					CopierDansD (plageB)
				End If
			Else
			a = maxA
			End If
		Next
		a = 1
	Next
End Sub

Sub CopierDansD(maPlageB)
	Range("D1").Select
	If IsEmpty(ActiveCell.Value) Then
		ActiveCell.Value = Range(maPlageB).Value
	Else
		If IsEmpty(ActiveCell.Offset(1, 0).Value) Then
			ActiveCell.Offset(1, 0).Value = Range(maPlageB).Value
		Else
			Selection.End(xlDown).Select
			ActiveCell.Offset(1, 0).Value = Range(maPlageB).Value
		End If
	End If
End Sub

Sub ComparerAaB()
	For a = 1 To maxA
		plageA = "A" & a
		Range(plageA).Select

		For b = 1 To maxB
			plageB = "B" & b
			If Range(plageB).Value <> Range(plageA).Value Then
				If b = maxB Then
					CopierDansC (plageA)
				End If
			Else
				b = maxB
			End If
		Next
		b = 1
	Next
End Sub

Sub CopierDansC(maPlageA)
	Range("C1").Select
		If IsEmpty(ActiveCell.Value) Then
			ActiveCell.Value = Range(maPlageA).Value
		Else
			If IsEmpty(ActiveCell.Offset(1, 0).Value) Then
				ActiveCell.Offset(1, 0).Value = Range(maPlageA).Value
			Else
				Selection.End(xlDown).Select
				ActiveCell.Offset(1, 0).Value = Range(maPlageA).Value
			End If
		End If
End Sub

Application 2 : compléter une colonne

Quand on veut rapprocher une liste de codes-barres avec données bibliographiques et la même liste avec des données statistiques, on a quelque chose comme ça :

A B C D
1500069441 1500141093 24
1500141093 1500203555 56
1500203555 1500069441 3
1500025348 1500025348 9

Il faut copier les éléments de la colonne D dans la colonne B en comparant les valeurs de C et de A :

Const Liste1 As String = "A"
Const Liste2 As String = "C"
Dim maxListe1 As Integer
Dim maxListe2 As Integer
Dim plageListe1 As String
Dim plageListe2 As String
Sub CompterLignes()
    Range(Liste1 & "1").Select
    Selection.End(xlDown).Select
    maxListe2 = Selection.Row
    Range(Liste2 & "1").Select
    Selection.End(xlDown).Select
    maxListe1 = Selection.Row
    Comparer
End Sub
Sub Comparer()
    For c = 1 To maxListe2
        plageListe2 = Liste2 & c
        Range(plageListe2).Select
        For a = 1 To maxListe1
            plageListe1 = Liste1 & a
            If Range(plageListe1).Value = Range(plageListe2).Value Then
                Range(plageListe1).Offset(0, 1).Value = Range(plageListe2).Offset(0, 1).Value
            End If
        Next
        a = 1
    Next
End Sub

Résultat :

A B C D
1500069441 3 1500141093 24
1500141093 24 1500203555 56
1500203555 56 1500069441 3
1500025348 9 1500025348 9

Application 3 : comparer dans les deux sens exemplaires et PPN

On part d'un fichier comme ceci :

PPN_U CB_U PPN_E CB_E
014645653 0260817301 014153726 0260286176
006196268 0260517980 014192985 0260345033
002019302 0261022421 014240742 0260512992
002288427 0260814201 00747413X 0260455930

Macro qui compare les colonnes 2 et 4 :

Sub CompareCB()
    Dim LigneDepart, LigneFinA, LigneFinB, JaiTrouve
    JaiTrouve = True
    ActiveSheet.Cells(2, 2).Select
    LigneDepart = Selection.Row
    LigneFinA = DetermineDerniereLigne(Selection.Column)
    ActiveSheet.Cells(2, 4).Select
    LigneFinB = DetermineDerniereLigne(Selection.Column)
    ActiveSheet.Cells(1, 5).Value = "PPN_U pas dans E"
    ActiveSheet.Cells(1, 6).Value = "CB_U pas dans E"
    ActiveSheet.Cells(1, 7).Value = "PPN_E pas dans U"
    ActiveSheet.Cells(1, 8).Value = "CB_E pas dans U"
    'On compare colonne 2 a colonne 4
    For Each ColonneA In ActiveSheet.Range(Cells(2, 2), Cells(LigneFinA, 2))
        For Each ColonneB In ActiveSheet.Range(Cells(2, 4), Cells(LigneFinB, 4))
            If ColonneA = ColonneB Then
                JaiTrouve = True
                Exit For
            End If
            JaiTrouve = False
        Next
        If JaiTrouve = False Then
            JaiTrouve = True
            ActiveSheet.Cells(LigneDepart, 5).NumberFormat = "@"
            ActiveSheet.Cells(LigneDepart, 6).NumberFormat = "@"
            ActiveSheet.Cells(LigneDepart, 5).Value = ActiveSheet.Cells(LigneDepart, 1).Value
            ActiveSheet.Cells(LigneDepart, 6).Value = ActiveSheet.Cells(LigneDepart, 2).Value
            LigneDepart = LigneDepart + 1
        End If
    Next
    'On passe a la comparaison inverse
    ActiveSheet.Cells(2, 4).Select
    LigneDepart = Selection.Row
    For Each ColonneB In ActiveSheet.Range(Cells(2, 4), Cells(LigneFinB, 4))
        For Each ColonneA In ActiveSheet.Range(Cells(2, 2), Cells(LigneFinA, 2))
            If ColonneB = ColonneA Then
                JaiTrouve = True
                Exit For
            End If
            JaiTrouve = False
        Next
        If JaiTrouve = False Then
            JaiTrouve = True
            ActiveSheet.Cells(LigneDepart, 7).NumberFormat = "@"
            ActiveSheet.Cells(LigneDepart, 8).NumberFormat = "@"
            ActiveSheet.Cells(LigneDepart, 7).Value = ActiveSheet.Cells(LigneDepart, 3).Value
            ActiveSheet.Cells(LigneDepart, 8).Value = ActiveSheet.Cells(LigneDepart, 4).Value
            LigneDepart = LigneDepart + 1
        End If
    Next
End Sub
Function DetermineDerniereLigne(Colonne As Integer)
    Dim ligneFin
    ligneFin = Columns(Colonne).Find("*", , , , xlByColumns, xlPrevious).Row
    DetermineDerniereLigne = ligneFin
End Function

Résultats :

PPN_U CB_U PPN_E CB_E PPN_U pas dans E CB_U pas dans E PPN_E pas dans U CB_E pas dans U
014645653 0260817301 014153726 0260286176 014645653 0260817301 014153726 0260286176
006196268 0260517980 014192985 0260345033 006196268 0260517980 014192985 0260345033
002019302 0261022421 014240742 0260512992 002019302 0261022421 014240742 0260512992
002288427 0260814201 00747413X 0260455930 002288427 0260814201 00747413X 0260455930