Optimisation du code

[ThyZeus]

Bonjour à tous,

Je cherche à obtenir le comportement suivant avec deux plages A et B : pour chaque cellule X de la page A, j'ajoute dans la cellule suivante la valeur "ok" si une des cellules Y de la plage B est contenue dans la cellule X.

J'ai testé plein de trucs sans grand succès et suis arrivé à sortir cette macro qui semble fonctionner mais demande beaucoup de ressources (j'ai plus de 10 000 éléments par plage) :

Sub test()
Dim celb As Range 'déclare la variable celb (cellule de la plage B)
Dim cela As Range 'déclare la variable cela (cellule de la plage A)
Dim lg As Byte 'déclare la variable lg (LonGueur)
 
'boucle 1 : sur toutes les cellules de la plage A
For Each celb In Sheets("Feuil1").Range("A3:A10745")
   
    'boucle 2 : sur toutes les cellules de la plage B
    For Each cela In Sheets("Feuil2").Range("B2:B64371")
        'définit la variable lg (position, en nombre de caractères, du texte de cela dans celb)
        lg = InStrRev(celb.Value, cela.Value, -1, vbTextCompare)
       
        If lg > 0 Then ' si lg est positif (donc si le texte de cela existe dans celb)
            celb.Offset(0, 1).Value = "ok" 'place en colonne B la valeur
            Exit For ' sort de la boucle 2
        End If ' fin de la condition 1
    Next cela 'prochaine cellule cela de la boucle 2
 
Next celb 'prochaine cellule celb de la boucle 1
End Sub

Quelqu'un saurait-il comment optimiser tout ça ?
Merci par avance à tous ceux qui se penchent sur la question.

 

[ERIC S]

Re : Optimisation du code

Bonjour

peut-être avec find, à adapter cet exemple qui regarde si la valeur de C1 se retrouve dans A1:A500

With Worksheets(1).Range("a1:a500")
    Set c = .Find(Range("C1").Value, LookIn:=xlValues, lookat:=xlWhole)
    If Not c Is Nothing Then
        Range("C1").Offset(0, 1).Value = "ok"
    End If
End With
[CODE]

 

[Habitude]

Re : Optimisation du code

Bonjour

Peut-être que ceci conviendrait
Le XlPart ne réagit pas de la même facon que InStrRev en vbTextCompare.
j'ai aussi inversé l'ordre de recherche.

A tester pour la performance.

Sub test()
Dim cela As Range, fa
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
For Each cela In Sheets("Feuil2").Range("B:B").SpecialCells(xlCellTypeConstants)
    With Sheets("Feuil1").Range("A:A")
        Set c = .Find(what:=CStr(cela), lookat:=xlPart)
        If Not c Is Nothing Then
            fa = c.Address
            Do: c.Offset(, 1) = "ok": Set c = .FindNext(c): Loop While Not c Is Nothing And c.Address <> fa
        End If
    End With
Next cela
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End Sub

 

[Si...]

Re : Optimisation du code

salut Tous

et ainSi...

Sub test()
  Dim celB As Range, celA As Range
  For Each celB In Sheets("Feuil1").Range("A3:A10745")
    For Each celA In Sheets("Feuil2").Range("B2:B64371")
      If celA Like "*" & celB & "*" Then celB.Offset(, 1) = "ok"
      'si 1 seul cas prévu : Exit for
    Next
  Next
End Sub

 

[ThyZeus]

Re : Optimisation du code

merci à tous pour ces retours, je teste et vous tiens au courant.