VBA Peut-on améliorer cette boucle

[Arpette]

Bonsoir à toutes et à tous, j'essaie de supprimer un maximum de boucle dans une macro pour gagner du temps. Est-ce que l'on peut faire quelque chose de plus rapide pour celle-ci. Mes feuilles font "5-9-12" = 20000 lignes et "Product_Line" = 100 lignes

Il s'agit de renvoyer en colonne Q "5-9-12" les valeurs trouvées en colonne B "Product_Line"

Merci de votre aide
@+

Set e = Worksheets("5-9-12").Range("A" & Worksheets("5-9-12").Range("A65536").End(xlUp).Row)
Set f = Worksheets("Product_Line").Range("A" & Worksheets("Product_Line").Range("A65536").End(xlUp).Row)
Do While e.Row > 1
    With Worksheets("Product_Line").Range("A2:A" & Worksheets("Product_Line").Range("A65536").End(xlUp).Row)
        Set f = .Find(e)
        If Not f Is Nothing Then
            Départ = f.Address
            'Do
                e(1, 17) = f(1, 2)
            Set f = .FindNext(f)
            Loop While Not f Is Nothing And f.Address <> Départ
        End If
    End With
Set e = e(0, 1)
Loop

 

[CBernardT]

Re : VBA Peut-on améliorer cette boucle

Bonsoir Arpette et le forum,

Une macro qui devrait aller vite.

Tri des deux bases pour éviter de reprendre à la première valeur du tableau à chaque bon résultat.

 

[Robert]

Re : VBA Peut-on améliorer cette boucle

Bonsoir Arpette, Bernard, bonsoir le forum,

La macro ci-dessous a peu de chance d'aller plus vite que la tienne mais elle me semble en tous cas plus claire...

Sub Macro2()
Dim pl1 As Range 'déclare la variable pl1 (PLage 1)
Dim pl2 As Range 'déclare la variable pl2 (PLage 2)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim r As Range 'déclare la variable r (Recherche)
Dim pa As String 'déclare la variable pa (Première Adressse)
 
With Sheets("Product_Line") 'prend en compte l'onglet "Product_Line"
    Set pl1 = .Range("A2:A" & .Range("A65536").End(xlUp).Row) 'définit la plage pl1
End With 'fin de la prise en compte l'onglet "Product_Line"
 
With Worksheets("5-9-12") 'prend en compte l'onglet "5-9-12"
    Set pl2 = .Range("A2:A" & .Range("A65536").End(xlUp).Row) 'définit la plage pl2
End With 'fin de la prise en compte l'onglet "5-9-12"
 
For Each cel In pl1 'boucle sur toutes les cellules éditée cel de la plage pl1
    Set r = pl2.Find(cel.Value, , xlValues, xlWhole) 'définit la recherche r (recheche la valeur de la cellule cel dans la plage pl2)
    If Not r Is Nothing Then 'condition : si il existe au moins une occurrence trouvée dans la plage pl2
        pa = r.Address 'définit la première adresse de l'occurence
        Do 'exécute
            r.Offset(0, 16).Value = cel.Offset(0, 1).Value 'place en colonne Q de l'occurence trouvée la valeur de la colonne B de cel
            Set r = pl2.FindNext(r) 'redéfinit la recherche (occurrence suivante)
        Loop While Not r Is Nothing And r.Address <> pa 'boucle tant qu'il existe des occurrences ailleurs qu'en pa
    End If 'fin de la condition
Next cel 'prochaine cellule cel de la plage pl1
End Sub

 

[kjin]

Re : VBA Peut-on améliorer cette boucle

Bonsoir le fil,
Edit : Supprimé, testé sur 20000 lignes, pas photo...
A+
kjin

 

[Arpette]

Re : VBA Peut-on améliorer cette boucle

Bonsoir Bernard, Robert et Kjin, j'ai mis dans deux modules séparés celui de Robert et le mien. Sur 34647 lignes Robert 10", le mien 14". Il y a bien une différence, mais dans mon fichier de base cette partie de code tourne pendant une quinzaine de minutes, j'ai fait un copier collé des deux feuilles, donc je ne comprends pas un tel écart. Bernard je ne peux pas trier dans ma feuille "5-9-12".
Mais j'ai quand même une question : est-ce normal que ma macro fasse 33 mo sans données, juste la macro, il y a pas des moments où je devrais libérer de la mémoire.
Merci à tous les trois pour votre aide.
@+

 

[kjin]

Re : VBA Peut-on améliorer cette boucle

Bonsoir,
J'ai retesté la proposition précédente (supprimée) avec 30000 entrées et 1000 sur la feuille Product_Line

Dim c As Range
t = Timer
Set c = Range("Q2:Q" & Range("A65000").End(xlUp).Row)
c.Formula = "=IF(ISNA(VLOOKUP($A2,Product_Line!$A$2:$B$1000,2,0)),"""",VLOOKUP($A2,Product_Line!$A$2:$B$1000,2,0))"
c.Value = c.Value
MsgBox Timer - t

...1,12s, en mode calcul auto ou non
A+
kjin

 

[Arpette]

Re : VBA Peut-on améliorer cette boucle

Rebonsoir Kjin, c'est très rapide, mais il me manque des valeurs. Pour info, au lancement de la macro, je teste si toutes les valeurs en "5-9-12" existent en "Product_Line" si non, je sorts et oblige à renseigner. Donc je n'ai jamais de NA. Ci-joint la partie de mon fichier avec ton code.
Merci de ton aide
@+
Cijoint.fr - Service gratuit de dépôt de fichiers

 

[kjin]

Re : VBA Peut-on améliorer cette boucle

Bonsoir,

Rebonsoir Kjin, c'est très rapide, mais il me manque des valeurs

Bin oui mon lapin, mais tu cherches des valeurs numériques dans une matrice qui elle contient, et du texte, et des valeurs numériques, donc il y a un schisme...
A+
kjin

 

[Fo_rum]

Re : VBA Peut-on améliorer cette boucle

Bonsoir,

Redite :

Il te faut avoir le même type de données dans les 2 feuilles !​

Commence par convertir tes textes en nombre.
​

Pour aller un peu plus vite, essaie l'adaptation du code de kjin :

Sub Macro4()
  Dim Dl As Long, C As Range
  T = Timer
  Dl = Cells(Rows.Count, 1).End(xlUp).Row
  Set C = Range("Q2:Q" & Dl)
  Dl = Sheets("Product_Line").Cells(Rows.Count, 1).End(xlUp).Row
  C.FormulaLocal = "=RECHERCHEV($A2;Product_Line!$A$2:$B$" & Dl & ";2;0)"
  C.Value = C.Value
  MsgBox Timer - T
End Sub

Il y a peu, la rapidité de recherche a été "travaillée" Ici !

 

[Arpette]

Re : VBA Peut-on améliorer cette boucle

Bonsoir à tous, j'ai tout remis au format texte, mais j'ai toujours des valeurs qui ne sont pas trouvées. Je n'y comprends plus rien
Merci de votre aide
@+

Sub Macro4()
Dim a As Range
Dim b As Range
Dim c As Range
t = Timer
Set a = Sheets("Product_Line").Range("A2:A" & Range("A1000").End(xlUp).Row)
    a.NumberFormat = "@"
Set b = Sheets("5-9-12").Range("A2:A" & Range("A65536").End(xlUp).Row)
    b.NumberFormat = "@"
Set c = Range("Q2:Q" & Range("A65000").End(xlUp).Row)
    c.Formula = "=IF(ISNA(VLOOKUP($A2,Product_Line!$A$2:$B$1000,2,0)),"""",VLOOKUP($A2,Product_Line!$A$2:$B$1000,2,0))"
    c.Value = c.Value
MsgBox Timer - t
End Sub

 

[kjin]

Re : VBA Peut-on améliorer cette boucle

Bonsoir,

Sub Macro4()
Dim c As Range
t = Timer
With Sheets("Product_Line")
Set a = .Range("IV2:IV" & .Range("A65000").End(xlUp).Row)
    a.Formula = "=$A2*1"
Set b = .Range("A2:A" & .Range("A65000").End(xlUp).Row)
    b.Value = a.Value
    a.Clear
End With
Set c = Range("Q2:Q" & Range("A65000").End(xlUp).Row)
    c.Formula = "=VLOOKUP($A2,Product_Line!$A$2:$B$1000,2,0)"
    c.Value = c.Value
MsgBox Timer - t
End Sub

0,15 s avec le fichier fourni
A+
kjin

 

[Arpette]

Re : VBA Peut-on améliorer cette boucle

Bonsoir Kjin, le code est très rapide. J'ai modifié un peu car je ne suis pas sur la feuille "5-9-12" quand je lance la macro. Je pense que c'est correcte
Merci de ton aide et de tes éventuelles remarques
@+

With Sheets("Product_Line")
    Set e = Sheets("Product_Line").Range("IV2:IV" & .Range("A65000").End(xlUp).Row)
        e.Formula = "=$A2*1"
    With Sheets("5-9-12")
        Set f = .Range("A2:A" & .Range("A65000").End(xlUp).Row)
            f.Value = e.Value
            e.Clear

        Set s = .Range("Q2:Q" & Range("A65000").End(xlUp).Row)
            s.Formula = "=VLOOKUP($A2,Product_Line!$A$2:$B$1000,2,0)"
            s.Value = s.Value
    End With
End With