comparaison cellules entre deux classeurs

[lestan]

Bonjour,

je souhaite comparer chaque cellule de la colonne F du classeur "macro selection" (feuil2) à toutes les cellules du classeur "tableau référence" et une cellule est en commun (ex: "E310" dans les deux colonnes) sortir ma valeur en rouge et si ce n'est pas le cas en vert. Au secours, je ne comprends pas .
Un grand merci et voilà ma macro.



Sub Comparaison1()
Application.ScreenUpdating = False
Dim Collection1 As New Collection, collection2 As New Collection
Dim Cellule1 As Range, Cellule2 As Range
Dim Element1 As Object, Element2 As Object
Dim Time1 As Date, Time2 As Date
Time1 = Now()
Workbooks("macro selection.xls").Activate
Worksheets("Feuil2").Activate
For Each Cellule1 In Range("F1:F100")
Collection1.Add Cellule1
Next Cellule1
Workbooks("tableau référence.xls").Activate
Worksheets("Feuil1").Activate
For Each Cellule2 In Range("B19:B500")
collection2.Add Cellule2
Next Cellule2
For Each Element1 In Collection1
For Each Element2 In collection2
If Element1.Value = Element2.Value Then
Element1.Font.Color = vbRed
Else
Element1.Font.Color = vbGreen

'Exit For
End If
Next Element2
Next Element1
Time2 = Now()
Debug.Print "Test collection :" & Format$(Time2 - Time1, "hh:mm:ss")
Application.ScreenUpdating = True
End Sub


Encore merci!!!

 

[lestan]

Re : comparaison cellules entre deux classeurs

Escusez moi mais j'écris de la merde, sur le deuxième classeur je recherche seulement sur une colonne et SI c'est bon je change la police en rouge.

Merci encore

 

[BOISGONTIER]

Re : comparaison cellules entre deux classeurs

Bonjour,

Sub Comparaison()
    Application.ScreenUpdating = False
    Set MonDico = CreateObject("Scripting.Dictionary")
    t = Timer
    Workbooks("tableau référence.xls").Activate
    Worksheets("Feuil1").Activate
    For Each c In Range("B19:B500")
      If Not MonDico.Exists(c.Value) Then MonDico.Add c.Value, c.Value
    Next c
    Workbooks("macro selection.xls").Activate
    Worksheets("Feuil2").Activate
    For Each c In Range("F1:F100")
        If MonDico.Exists(c.Value) Then
          c.Interior.ColorIndex = xlNone
        Else
          c.Interior.ColorIndex = 3
        End If
    Next c
    MsgBox Timer() - t
    Application.ScreenUpdating = True
End Sub

JB

 

[lestan]

Re : comparaison cellules entre deux classeurs

Merci,
ca marche j'ai plus qu'à modifier les conséquences et c'est bon. Très bonne soirée.