Bonjour à tous,
J'ai récupéré par le biais d'autres forum la Macro ci-dessous.
Cette dernière permets de comparer deux listes de données et renvoi un "rapport" sous la forme suivante.
A. Colonne 1 - Colonne 2
B. Colonne 2 - Colonne 1
C. Valeurs communes entre Colonne 1 et 2
La macro marche nickel à un détail près. En effet dans mes colonnes j'ai des références d'articles qui peuvent commencer par des 0. Afin de garder ce 0 au début de mes réf. je mets mes cellules en Texte. Hors la Macro à l'air de ne pas fonctionner avec ce type de format.
Quelqu'un aurait-il une solution à mon problème SVP ? Voilà la Macro :
Private Sub CommandButton1_Click()
Dim derlig1 As Long, derlig2 As Long
Dim tablo1, tablo2, tablo3
Dim dico1 As Object, dico2 As Object, ref As String
Dim nbre1 As String, nbre2 As String, liste1, liste2
Dim cptr As Long, cptr1 As Long, cptr2 As Long, cptr3 As Long
ReDim tablo1(0)
ReDim tablo2(0)
ReDim tablo3(0)
'mémorise les reférences uniques dans feuilles 1 et 2
With Sheets(3)
derlig1 = .Range("A65536").End(xlUp).Row
Set dico1 = CreateObject("Scripting.Dictionary")
For cptr = 2 To derlig1
ref = .Cells(cptr, 1)
If Not dico1.exists(ref) Then
dico1.Add ref, ref
End If
Next
nbre1 = dico1.Count - 1
liste1 = dico1.items
End With
With Sheets(4)
derlig2 = .Range("A65536").End(xlUp).Row
Set dico2 = CreateObject("Scripting.Dictionary")
For cptr = 2 To derlig2
ref = .Cells(cptr, 2)
If Not dico2.exists(ref) Then
dico2.Add ref, ref
End If
Next
nbre2 = dico2.Count - 1
liste2 = dico2.items
End With
'----- mémorise en variables-tableaux les éléments uniques de la feuille1 (tablo1) _
et communs feuill1-feuill2 (tablo3)
For cptr = 0 To nbre1
If Not dico2.exists(liste1(cptr)) Then
tablo1(cptr1) = liste1(cptr)
cptr1 = cptr1 + 1
ReDim Preserve tablo1(cptr1)
Else
tablo3(cptr3) = liste1(cptr)
cptr3 = cptr3 + 1
ReDim Preserve tablo3(cptr3)
End If
Next
'----- mémorise en variables-tableau les éléments uniques de la feuille2 (tablo2)
For cptr = 0 To nbre2
If Not dico1.exists(liste2(cptr)) Then
tablo2(cptr2) = liste2(cptr)
cptr2 = cptr2 + 1
ReDim Preserve tablo2(cptr2)
End If
Next
'-----restitution en feuille 3
Application.ScreenUpdating = False
With Sheets(5)
.Range("A2:C65536").Clear
.Range("A2").Resize(UBound(tablo1) + 1, 1) = Application.Transpose(tablo1)
.Range("B2").Resize(UBound(tablo2) + 1, 1) = Application.Transpose(tablo2)
.Range("C2").Resize(UBound(tablo3) + 1, 1) = Application.Transpose(tablo3)
.Activate
End With
End Sub
J'ai récupéré par le biais d'autres forum la Macro ci-dessous.
Cette dernière permets de comparer deux listes de données et renvoi un "rapport" sous la forme suivante.
A. Colonne 1 - Colonne 2
B. Colonne 2 - Colonne 1
C. Valeurs communes entre Colonne 1 et 2
La macro marche nickel à un détail près. En effet dans mes colonnes j'ai des références d'articles qui peuvent commencer par des 0. Afin de garder ce 0 au début de mes réf. je mets mes cellules en Texte. Hors la Macro à l'air de ne pas fonctionner avec ce type de format.
Quelqu'un aurait-il une solution à mon problème SVP ? Voilà la Macro :
Private Sub CommandButton1_Click()
Dim derlig1 As Long, derlig2 As Long
Dim tablo1, tablo2, tablo3
Dim dico1 As Object, dico2 As Object, ref As String
Dim nbre1 As String, nbre2 As String, liste1, liste2
Dim cptr As Long, cptr1 As Long, cptr2 As Long, cptr3 As Long
ReDim tablo1(0)
ReDim tablo2(0)
ReDim tablo3(0)
'mémorise les reférences uniques dans feuilles 1 et 2
With Sheets(3)
derlig1 = .Range("A65536").End(xlUp).Row
Set dico1 = CreateObject("Scripting.Dictionary")
For cptr = 2 To derlig1
ref = .Cells(cptr, 1)
If Not dico1.exists(ref) Then
dico1.Add ref, ref
End If
Next
nbre1 = dico1.Count - 1
liste1 = dico1.items
End With
With Sheets(4)
derlig2 = .Range("A65536").End(xlUp).Row
Set dico2 = CreateObject("Scripting.Dictionary")
For cptr = 2 To derlig2
ref = .Cells(cptr, 2)
If Not dico2.exists(ref) Then
dico2.Add ref, ref
End If
Next
nbre2 = dico2.Count - 1
liste2 = dico2.items
End With
'----- mémorise en variables-tableaux les éléments uniques de la feuille1 (tablo1) _
et communs feuill1-feuill2 (tablo3)
For cptr = 0 To nbre1
If Not dico2.exists(liste1(cptr)) Then
tablo1(cptr1) = liste1(cptr)
cptr1 = cptr1 + 1
ReDim Preserve tablo1(cptr1)
Else
tablo3(cptr3) = liste1(cptr)
cptr3 = cptr3 + 1
ReDim Preserve tablo3(cptr3)
End If
Next
'----- mémorise en variables-tableau les éléments uniques de la feuille2 (tablo2)
For cptr = 0 To nbre2
If Not dico1.exists(liste2(cptr)) Then
tablo2(cptr2) = liste2(cptr)
cptr2 = cptr2 + 1
ReDim Preserve tablo2(cptr2)
End If
Next
'-----restitution en feuille 3
Application.ScreenUpdating = False
With Sheets(5)
.Range("A2:C65536").Clear
.Range("A2").Resize(UBound(tablo1) + 1, 1) = Application.Transpose(tablo1)
.Range("B2").Resize(UBound(tablo2) + 1, 1) = Application.Transpose(tablo2)
.Range("C2").Resize(UBound(tablo3) + 1, 1) = Application.Transpose(tablo3)
.Activate
End With
End Sub
