Optimisation boucle vba

Résolu/Fermé
Signaler
Messages postés
4
Date d'inscription
vendredi 7 août 2015
Statut
Membre
Dernière intervention
9 août 2015
-
Messages postés
4
Date d'inscription
vendredi 7 août 2015
Statut
Membre
Dernière intervention
9 août 2015
-
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

7 réponses

Messages postés
14832
Date d'inscription
vendredi 14 mars 2003
Statut
Modérateur
Dernière intervention
5 décembre 2021
311
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.
Messages postés
16538
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
1 décembre 2021
3 252
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
Messages postés
4
Date d'inscription
vendredi 7 août 2015
Statut
Membre
Dernière intervention
9 août 2015

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
Messages postés
16129
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
5 décembre 2021
1 566
Bonjour a vous tous,

2 minutes pour ne rien trouver, c'est genant !!!

Il n'y a aucune correspondance valide entre les cellules de la colonne U de abc et la colonne P de passage dans ce que vous avez mis a dispo !!!!!!!!!!

Z'etes sur des 95000 lignes, car votre fichier est un xls de 65000 lignes

A+
Messages postés
16538
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
1 décembre 2021
3 252
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
Messages postés
4
Date d'inscription
vendredi 7 août 2015
Statut
Membre
Dernière intervention
9 août 2015

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
Messages postés
16538
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
1 décembre 2021
3 252
Il faut bien te rendre compte que ce que tu demandes n'est pas forcément facile et que personne ne veut passer parfois plusieurs heures à essayer de résoudre un problème bénévolement pour se voir dire après coup " je commencais à fatiguer"...

c'est toi qui m'a fatigué
de toutes façons tu as le principe en utilisant dictionary; donc, fatigue toi encore un peu
Messages postés
16129
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
5 décembre 2021
1 566
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
Messages postés
4
Date d'inscription
vendredi 7 août 2015
Statut
Membre
Dernière intervention
9 août 2015

Bonsoir à tous le monde

En adaptant le code de Michel ça a focntionner.

Je remercie tout le monde pour votre apport.