VBA Probleme avec l'utilisation des dictionnaires

Ca fonctionne; merci Amir. En revanche, (et c'est ce que je craignais) c'est que c'est encore un peu long : 3min 15sec...

Je vais continuer d'explorer les pistes des dictionnaires notamment celle de Klin89 pour voir si le temps de traitement peut etre optimisé, (d’après Jacques Boisgontier, c'est 100x plus rapide avec les dicos...)

Merci encore

comment tu a evalue le temps

Le timer m'a annoncé 39 sec mais c'était bien plus que ça donc j'ai relancé avec un chrono en même temps.

oui ,pcq j ai edité les codes , SVP Ressayer le premier , et si tu veux le deuxieme

Avec le 2ème code (et les 13.000 changements de statuts) je suis à 13 min

tu parle de celui ca

Sub Comparaison()
Dim Start, Finish
Start = Timer    ' Définit l'heure de début.
Dim F1 As Worksheet, F2 As Worksheet, c
Dim nbF1 As Long, nbF2 As Long, i As Long
Application.ScreenUpdating = False
Set F1 = Sheets("F1")
Set F2 = Sheets("F2")
nbF1 = F1.Range("F" & Rows.Count).End(xlUp).Row
nbF2 = F2.Range("F" & Rows.Count).End(xlUp).Row
With F2
For i = 2 To nbF2
Set c = F1.Range("F2:F" & nbF1).Find(.Range("F" & i), , , xlWhole)
If Not c Is Nothing Then
F1.Range("E" & c.Row) = .Range("E" & i)
.Range("F" & i).Font.Color = vbBlack
Else
.Range("F" & i).Font.Color = vbBlue
End If
'End If
Next
End With
Application.ScreenUpdating = True
Finish = Timer
MsgBox Finish - Start & " seconde(s)"
End Sub

non l'autre

SVP ressayer ca

Sub Comparaison()
Dim Start, Finish
Start = Timer    ' Définit l'heure de début.
Dim F1 As Worksheet, F2 As Worksheet, c
Dim nbF1 As Long, nbF2 As Long, i As Long
Application.ScreenUpdating = False
Set F1 = Sheets("F1")
Set F2 = Sheets("F2")
nbF1 = F1.Range("F" & Rows.Count).End(xlUp).Row
nbF2 = F2.Range("F" & Rows.Count).End(xlUp).Row
With F2
For i = 2 To nbF2
Set c = F1.Range("F2:F" & nbF1).Find(.Range("F" & i), , , xlWhole)
If Not c Is Nothing Then
F1.Range("E" & c.Row) = .Range("E" & i)
.Range("F" & i).Font.Color = vbBlack
Else
.Range("F" & i).Font.Color = vbBlue
End If
'End If
Next
End With
Application.ScreenUpdating = True
Finish = Timer
MsgBox Finish - Start & " seconde(s)"
End Sub

Re bad_seed,

La mise en forme de tes cellules sera de toute façon gourmande en temps.

Compare mon code précédent avec celui-ci

Option Explicit
Sub test()
Dim a, i As Long, dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    a = Sheets("F2").Range("a1").CurrentRegion.Value
    For i = 2 To UBound(a, 1)
        dico(a(i, 6)) = a(i, 5)
    Next
    Application.ScreenUpdating = False
    With Sheets("F1").Range("a1").CurrentRegion
        a = .Value
        For i = 2 To UBound(a, 1)
            If dico.exists(a(i, 6)) Then
               'If a(i, 5) = "En attente" And dico(a(i, 6)) = "Vente non aboutie" Then
                 If a(i, 5) <> dico(a(i, 6)) Then
                    a(i, 5) = dico(a(i, 6))
                End If
                .Cells(i, 6).Interior.ColorIndex = 44
            Else
                .Cells(i, 6).Interior.ColorIndex = 37
            End If
        Next
        .Value = a
    End With
    Set dico = Nothing
    Application.ScreenUpdating = True
End Sub

J'ai aussi changé la condition, à toi de voir.

klin89

Désolé de répondre si tard.

Klin89 c'est nickel ca marche super et en 10sec !!

Maintenant je comprends pas tout à ton code mais je vais essayer de le décortiquer si jamais j'ai des modifs à faire

Encore merci à tous pour votre disponibilité et particulièrement à Klin89 (super code !!)

A bientôt

Bad_seed