optimisation boucle vba Résolu/Fermé

Question

Bonjour tous le monde, A l'aide, Je dois rendre un travail la semaine prochaine. En effet, je boucle sur plus de 95565 lignes, avec bien entendu des calculs entre temps. Mon problème est que mon code n'est pas optimisé. Je vous mets le code, si vous pouvez m'aidez Sub correspondance_abc_passage_LSCO() Application.ScreenUpdating = False 'filtre données base abc sur scolaire pour diminuer le nombre de lignes sur lesquelles boucler. Call remonte_sco_abc Call remonte_sco_passage l = Sheets("abc").Range("A3").End(xlDown).Row Sheets("abc").Range("AA3:AA" & l).ClearContents array1 = Sheets("abc").Range("G3:AA" & l).Value ll = Sheets("passage").Range("A4").End(xlDown).Row array2 = Sheets("passage").Range("P4:Q" & ll).Value For i = LBound(array1) To UBound(array1) 'condtion pour continuer le traitement c'est à dire il faut avoir du scolaire If array1(i, 1) = "SCOLAIRE" Then j = 1 Do If array1(i, 20) = array2(j, 1) Then array1(i, 21) = "trouvee" Exit Do End If j = j + 1 Loop Until array2(j, 2) <> "SCOLAIRE" If array1(i, 21) <> "trouvee" Then array1(i, 21) = "non trouvee" End If Else Exit For End If Next ' à la sortie ici j'aura fini les scolaires. Sheets("abc").Range("G3:AA" & l).Value = array1 'j 'appel ensuite la fonction qui permet de faire le même traitement pour les lignes régulières. Call correspondance_abc_passage_LREG Application.ScreenUpdating = True End Sub Ci joint également le code correspondant à correspondance_abc_passage_LREG Sub correspondance_abc_passage_LREG() Application.ScreenUpdating = False 'filtre données base abc sur scolaire pour aller plus vite Call remonte_reg_abc Call remonte_reg_passage l = Sheets("abc").Range("A3").End(xlDown).Row array1 = Sheets("abc").Range("G3:AA" & l).Value ll = Sheets("passage").Range("A4").End(xlDown).Row array2 = Sheets("passage").Range("P4:Q" & ll).Value For i = LBound(array1) To UBound(array1) 'condtion pour continuer le traitement c'est à dire il faut avoir du scolaire If array1(i, 1) = "LIGNE REG" Then j = 1 Do If array1(i, 20) = array2(j, 1) Then array1(i, 21) = "trouvee" Exit Do End If j = j + 1 Loop Until array2(j, 2) <> "LIGNE REG" If array1(i, 21) <> "trouvee" Then array1(i, 21) = "non trouvee" End If Else Exit For End If Next Sheets("abc").Range("G3:AA" & l).Value = array1 Application.ScreenUpdating = True End Sub Je vous remercie d'avance pour votre aide. BARRY

NHenry · Answer

Avec Excel, je ne pense pas que tu puisse aller plus loin, 95565 lignes, c'est une base de données, pas un tableau de calcul.

michel_m · Answer

Bonjour

En complément de ton code, envoie ton classeur ou un extrait ( 1000 à 2000 lignes) avec les explications  de ce que tu veux faire car avant de comprendre tes codes, bonjour...

Déjà, il n'y a pas de déclarations de variables...

Call remonte_sco_abc
  Call remonte_sco_passage 
Call remonte_reg_abc
  Call remonte_reg_passage
?????
pas vu ces procédures


Mettre le classeur sans données confidentielles en pièce jointe sur https://www.cjoint.com/
et coller le raccourci  proposé (clic droit) dans le message de réponse
Dans l'attente
 
 
 
 Michel

barry_mohamed · Answer

Bonjour tout le monde,

Merci pour vos différentes réponses.

Call remonte_sco_abc 
Call remonte_sco_passage 
Call remonte_reg_abc 
Call remonte_reg_passage

sont juste des filtres automatiques pour remonter les données afin de limiter le nombre d'itération. C'est pourquoi je n'ai pas mis le code car ils s'exécutent très rapidement.

Sinon pour le reste je mets les données à disposition voir onglet explications pour comprendre l'attente.

 https://www.cjoint.com/c/EHiriAvtSrH 



En vous remerciant d'avance pour vos réponses

michel_m · Answer

bonjour,

effectivement, aucune correspondance comme le dit F89 que je salue en ce dimanche .... 

ci dessous le code suivant tes explications en feuille "explications":
Pour chaque contenu de la colonne U de la feuille abc, je recherche si j'ai une correspondance dans la feuille passage (colonne P)
si je trouve une correspondance je marque "trouvee" dans la colonne W de la feuill abc
 

à aménager en fonction du CLASSEUR REEL et DES COLONNES REELLES 
:-((
 
Durée  pour remplir colonne W: 0,12 secondes

Option Explicit
'-------------------------------------------------
Sub trouver()
Dim Derlig As Long, T_colu As Variant, T_colw As Variant
Dim D_pass As Object, T_colp As Variant, Cptr As Long
Dim idx As Long
Dim start As Single

'-------initialisations
    Application.ScreenUpdating = False
    start = Timer
    'mémorisation données en RAM
    With Sheets("passage")
        Derlig = .Columns("P").Find(what:="*", searchdirection:=xlPrevious).Row
        T_colp = Application.Transpose(.Range("P3:P" & Derlig))
        'création d'un objet dictionnaire: liste des uniques en colonne p
        Set D_pass = CreateObject("scripting.dictionary")
        For Cptr = 1 To UBound(T_colp)
            If Not D_pass.exists(T_colp(Cptr)) Then D_pass.Add T_colp(Cptr), ""
        Next
    End With
    With Sheets("abc")
        Derlig = .Columns("U").Find(what:="*", searchdirection:=xlPrevious).Row
        T_colu = Application.Transpose(.Range("U3:U" & Derlig))
        T_colw = Application.Transpose(.Range("W3:W" & Derlig))
    End With
    
'------- affectation T_colw  si correspondance d_pass & col u
    For idx = 1 To UBound(T_colu)
        If D_pass.exists(T_colu(idx)) Then T_colw(idx) = "trouvée"
    Next
'restitution
    With Sheets("abc")
        .Range("U3:U" & Derlig) = Application.Transpose(T_colw)
        .Activate
    End With
    
    Application.ScreenUpdating = True
    MsgBox (" durée d'exécution: " & Timer - start & " sec.")
End Sub


mais vu le manque de sérieux dans la demande, j'arr^te ici le suivi de la discussion


EDIT : Ajout du langage dans les balises de code.

 Michel

barry_mohamed · Answer

Merci à tous .

Effectivement il y avait bien une erreur qui s'était glisée et qui faisait qu'on ne trouvait aucune correspondance. Je viens de corriger. Je remets donc le nouveau lien.

https://www.cjoint.com/c/EHjlKdQuJxY

Merci en tout Michel, mais c'est dommage que vous ne veuilliez plus me suivre. En effet, c'est juste une inattention de ma part j'y ai bossé toute la semaine et je commençait à fatiguer. Sinon je suis rigoureux en temps normal. Mais merci en tout cas

f894009 · Answer

Re,

Salut Michel_m

barry_mohamed: petite question vu que vous n'avez mis que des lignes avec LIGNE REG dans l'onglet passage, quelle est la difference reel entre les LIGNE REG et SCOLAIRE, si il y en a une, au niveau du "nom" dans la colonne P de passage

barry_mohamed · Answer

Bonsoir à tous le monde 

En adaptant le code de Michel ça a focntionner.

Je remercie tout le monde pour votre apport.

Optimisation boucle vba

7 réponses

Discussions similaires