boucle et condition trop long à executer !!

[Capsule]

Bonjour

j'ai fait une macro pour comparer les valeurs de 2 listes et coller dans la 1ere une valeur de la 2eme si la condition est rempli. Le probleme est que ma liste fait 48 000 lignes et la 2eme 184. Du coup la boucle est trop longue, puisque je test sur 2000 lignes et dejà ça rame.
voici le code : si quelqu'un siat comment optimiser la macro pour faire plus court.

Sub Test()

'selection de la derniere ligne
DerLigDonnees = Worksheets("DONNEES").Range("A65536").End(xlUp).Row
DerLigFam = Worksheets("LIB FAM").Range("A65536").End(xlUp).Row

'comptage
    For e = 2 To DerLigDonnees
        For i = 1 To DerLigFam
        If Worksheets("DONNEES").Range("F" & e).Value = Worksheets("LIB FAM").Range("A" & i).Value Then Worksheets("DONNEES").Range("O" & e).Value = Worksheets("LIB FAM").Range("B" & i).Value
        Next
    Next

End Sub

merci

 

[wilfried_42]

Re : boucle et condition trop long à executer !!

Bonjour et bienvenue

Question : as tu plusieures valeurs identiques possibles ? ou une seule ?

si une seule

Sub Test()
dim cellule as range
'selection de la derniere ligne
DerLigDonnees = Worksheets("DONNEES").Range("A65536").End(xlUp).Row
    For e = 2 To DerLigDonnees
        set cellule = nothing
        set cellule = sheets("LIB FAM").range("A:A").Find(sheets("DONNEES").range("O" & e).value lookin:=XlValues)
        if not cellule is nothing then sheets("DONNEES").range("O" & e).value = cellule.offset(0,1)
    Next e
End Sub

mais avec une fichier exemple, cela serait plus simple

 

[Capsule]

Re : boucle et condition trop long à executer !!

Yahooooooo, rapide la réponse !!
Merci .

plusieurs valeurs identiques (184 en tout, sur la feuille LIB FAM), reparties sur les 48 000 lignes (environ) de la 1ere feuille DONNEES.

 

[Capsule]

Re : boucle et condition trop long à executer !!

voici un fichier exemple.

dans "DONNEES" pour chaque valeurs de colonne F, chercher dans "LIB FAM" et coller en O la valeur trouvée.

ici pour famille "HBE" en F2 la macro doit mettre en O2 "famille machin 91"

merci

 

[Capsule]

Re : boucle et condition trop long à executer !!

une idée ?

 

[wilfried_42]

Re : boucle et condition trop long à executer !!

re:

ma question etait, pas de doublon dans la feuille LIB FAM

Une seule reference ? dans cette feuille ?

 

[wilfried_42]

Re : boucle et condition trop long à executer !!

re:

faire les tests sur une seule ligne, dur dur m'enfin je crois que c'est bon
ton fichier en retour, j'ai ajouté une bouton,

pour acceder à la macro, Alt + F11, developper module, bouble click sur module 1

 

[Capsule]

Re : boucle et condition trop long à executer !!

salut,

Non pas de doublon en LIB FAM.

Je n'ai mis qu'une ligne dasn "données" pour l'exemple, mais normalement il y en à + de 50 000 ...

Je regarde ton code.
A+

 

[Capsule]

Re : boucle et condition trop long à executer !!

Hummmmm !! c'est bon quand ça marche !!

Merci ! ça roule. Un peu long encore mais nettement moins que ma 1ere macro.
A+

 

[wilfried_42]

Re : boucle et condition trop long à executer !!

re:

C'est normal, 50000 lignes à traiter n'est pas une mince affaire, par contre, .find, va directement à la famille cherchée et permet d'oter une boucle

 

[Capsule]

Re : boucle et condition trop long à executer !!

justement, afin de gagner en rapidité, ne serait-ce pas plus simple de partir de la famille "LIB FAM" et de trouver toutes les redondances dans "données" ?

Sub RechercheCopiev2()

Dim cellule As Range, recherche As String, e As Long

'selection de la derniere ligne
DerLigFam = Worksheets("LIB FAM").Range("A65536").End(xlUp).Row
    
    For e = 1 To DerLigFam
        Set cellule = Nothing
        valeur = Sheets("LIB FAM").Range("A" & e).Value
        Set cellule = Sheets("DONNEES").Range("F:F").Find(valeur, LookIn:=xlValues)
        If Not cellule Is Nothing Then Sheets("DONNEES").Range("O" & e).Value = cellule.Offset(0, 1)
    Next e
End Sub

mais je ne sais pas comment faire pour passer à la recherche suivante dans "données".
A+

 

[wilfried_42]

Re : boucle et condition trop long à executer !!

Re:

Autre macro, qui fait l'inverse

    Dim table As Range, i As Long, cellule As Range, mem As Range
    Set table = Sheets("DONNEES").Range("F2:F" & Sheets("DONNEES").Range("A65536").End(xlUp).Row)
    For i = 1 To Sheets("LIB FAM").Range("A65536").End(xlUp).Row
        Set cellule = Nothing
        Set mem = Nothing
        Set cellule = table.Find(Sheets("LIB FAM").Range("A" & i).Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not cellule Is Nothing Then
            Set mem = cellule
            Do
                cellule.Offset(0, 9) = Sheets("LIB FAM").Range("B" & i)
                Set cellule = table.FindNext(after:=cellule)
            Loop While Not cellule Is Nothing And mem.Address <> cellule.Address
        End If
    Next i