Optimisation comparaison cellules colonnes

Bonjour,

J'ai réalisé ce programme pour retrouver les éléments qui n'ont pas de doublon (pour les grisés), cependant, je vois bien que ma méthode est très lente et j'ai un petit bug, je me retrouve toujours avec les 26 dernière cellule grisé sans raison valable.

Merci

bonsoir,

correction du bug dans ton code

Sub retrouver()

  Dim dLig1 As Long, Lig1 As Long
  Dim Sht1 As Worksheet, Sht2 As Worksheet
    Set Sht1 = ThisWorkbook.Sheets(1)
    Set Sht2 = ThisWorkbook.Sheets("MO-NEW PRICE BOOK")
    dLig1 = Sht1.Range("L" & Rows.Count).End(xlUp).Row
    Lig1 = Sht2.Range("A" & Rows.Count).End(xlUp).Row

    Dim Tableau() As String
    ReDim Preserve Tableau(dLig1)

    u = 28
    i = 2
    Do While i <= Lig1
        Do While u <= dLig1
            If Sht1.Range("L" & u) = Sht2.Range("A" & i) Or Sht1.Range("L" & u) = "" Then
                Tableau(u - 28) = "1"
                Exit Do
            End If
            u = u + 1
        Loop
    u = 28
    i = i + 1
    Loop

    u = 0
    Do While u <= dLig1 - 28
            If Tableau(u) = "" Then Sht1.Range("L" & u + 28).Interior.Color = RGB(128, 128, 128)
            u = u + 1
        Loop
End Sub

solution optimisée avec une MFC

Bonjour,

Merci pour votre réponse, effectivement le problème de la couleur est régler merci, maintenant je reste toujours embêter par la lenteur du programme, dans mon exemple je n'ai que quelque ligne mais en situation réel, j'aurai environ 1000 ligne pour la page 1 et environ 25 000 ligne pour la page 2, je me retrouve a devoir attendre plusieurs minutes ce qui est problématique.

Merci

la solution "MFC" de H2SO4 est immédiatement

Sub retrouver()
     Dim aNew, aA, UN, i

     t = Timer
     With ThisWorkbook.Sheets("MO-NEW PRICE BOOK")
          aNew = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp)).Value2     'matrice avec les nouveaux prix
     End With

     For Each Feuil In Array("Feuil1", "Feuil2")     '--->liste des feuilles à faire
          With ThisWorkbook.Sheets(Feuil)
               Set c = .Range(.Range("L28"), .Range("L" & Rows.Count).End(xlUp))     'matrice avec les anciens valeurs
               aA = c.Value2
     ' MsgBox c.Parent.Name & vbLf & c.Address
          End With

          Set UN = Nothing
          For i = 1 To UBound(aA)
               If Len(aA(i, 1)) > 0 Then     'non-vide
                    If Not IsNumeric(Application.Match(aA(i, 1), aNew, 0)) Then     'ne se trouve pas dans la nouvelle matrice
                         If UN Is Nothing Then Set UN = c(i, 1) Else Set UN = Union(UN, c(i, 1))     'rassembler toutes ces cellules
                    End If
               End If
          Next
          c.Interior.Color = RGB(255, 255, 255)     'RAZ couleur
          If Not UN Is Nothing Then UN.Interior.Color = RGB(128, 128, 128)     'colorer ces cellules
     Next
     MsgBox "prêt en " & Format(Timer - t, "0.0\s")
End Sub

Bonjour,

A oui d'accord, je n'avais pas compris "MFC" XP, mais effectivement, je connais et ça aurait été efficace, mais je dois supprimer la page avec mes références la fin de ma macro, en tout cas votre solution de code est effectivement vraiment plus rapide, je suis impressionné, merci encore.