Forum |  HardWare.fr | News | Articles | PC | S'identifier | S'inscrire | Shop Recherche
1192 connectés 

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  Boucles for imbriquées, macro trop lente

 


 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

Boucles for imbriquées, macro trop lente

n°2082075
Rizlonggra​in
Posté le 12-06-2011 à 19:46:56  profilanswer
 

Bonjour,
 
J'ai besoin de vos lumières!
J’ai réalisé un programme vba qui est beaucoup trop lent ! J’aimerais avoir vos conseils concernant de possibles évolutions !
 
Les données se présentent de la façon suivante : une colonne, représentant des objets, et une autre, donnant des dates de réalisation d’opérations liées à ces objets.  
Il peut y avoir plusieurs opérations et donc plusieurs dates par objet.
 
Le but du programme est :
- Dans un 1er temps, de trouver pour chaque objet la date la plus ancienne;
- Dans un 2nd temps, de comparer ces dates et de donner la date la plus récente et son objet associé.
 
Le programme que j’ai réalisé fonctionne mais est très lent (seulement 100 à 200 lignes de données à traiter et plusieurs minutes d’exécution).  
 

Code :
  1. Sub D_DatesDebutMsn()
  2. Application.ScreenUpdating = False
  3. Worksheets("Feuil3" ).Range("A:B" ).ClearContents
  4. Worksheets("data" ).Columns("D:G" ).NumberFormat = "General"
  5. LastRow = Worksheets("data" ).Range("A60000" ).End(xlUp).Row
  6. For i = 2 To LastRow
  7.     If Worksheets("data" ).Cells(i, 8).Value = "Oui" Then
  8.         first = Worksheets("data" ).Cells(i, 6).Value
  9.         vMsn = Worksheets("data" ).Cells(i, 2).Value
  10.         For j = 2 To LastRow
  11.             If j <> i Then
  12.                 If Worksheets("data" ).Cells(j, 2).Value = Worksheets("data" ).Cells(i, 2).Value Then
  13.                     If Worksheets("data" ).Cells(j, 6).Value < Worksheets("data" ).Cells(i, 6).Value Then
  14.                         If Worksheets("data" ).Cells(j, 6).Value > 0 Then
  15.                             first = Worksheets("data" ).Cells(j, 6).Value
  16.                             vMsn = Worksheets("data" ).Cells(j, 2).Value
  17.                         End If
  18.                     End If
  19.                 End If
  20.             End If
  21.             If first <> 0 Then
  22.                 Worksheets("Feuil3" ).Cells(i, 1).Value = vMsn
  23.                 Worksheets("Feuil3" ).Cells(i, 2).Value = first
  24.             End If
  25.         Next j
  26.     End If
  27. Next i
  28. Worksheets("data" ).Columns("D:G" ).NumberFormat = "m/d/yyyy"
  29. Worksheets("Feuil3" ).Columns("B:B" ).NumberFormat = "m/d/yyyy"
  30. Application.ScreenUpdating = True
  31. End Sub


 
Si vous avez des pistes pour l’améliorer ou même une méthode différente (peut être avec des recherchev ?? je ne vois pas trop comment faire..), ce serait génial !
Merci d’avance et bonne soirée !

mood
Publicité
Posté le 12-06-2011 à 19:46:56  profilanswer
 

n°2082118
billgatesa​nonym
Posté le 13-06-2011 à 08:41:02  profilanswer
 

Citation :

LastRow = Worksheets("data" ).Range("A60000" ).End(xlUp).Row
For i = 2 To LastRow


"A60000" fait un peu peur.  
 
Il y a combien de cellules à examiner ?
S'il y en a plus de mille, il est normale que le programme commence à ramer, car VBA est un langage qui s'exécute lentement. C'est un défaut connu, et pour lequel, il n'y a pas grand chose à faire.
 
Le code pourrait, peut-être, être optimiser un peu, par exemple, peut-être, en testant plus tôt si Worksheets("data" ).Cells(j, 6).Value > 0.
 
L'algorithme pourrait probablement être améliorer pour éviter la double boucle qui est très pénalisante. S'il y a 1000 lignes de données, la double boucle examinera 1000 x 1000 lignes, c'est-à-dire 1 000 000 de lignes !
 
Une amélioration importante serait réalisée, si les données étaient triées. Alors, la recherche de la date la plus ancienne s'effectuerait tout de suite, en prenant la ligne du haut ou du bas.
 
Si l'examen d'un million de lignes est nécessaire, alors il faut envisager d'exporter la feuille Excel, et de la traiter par un programme écrit en C.

n°2082176
Rizlonggra​in
Posté le 13-06-2011 à 17:57:54  profilanswer
 

Merci de ta réponse!
 
Oui j'ai peut être abusé sur le 60000 ! Je pourrais le réduire à 500, cela ne devrait pas poser de problème. J'ai environ 200 lignes à traiter.
 
Je vais essayer de mettre la condition Worksheets("data" ).Cells(j, 6).Value > 0 plus tôt!
 
Par contre, ce n'est pas aussi simple pour le tri! Il faudrait d'abord trier les dates par article (ou objet) afin d'avoir la date la plus ancienne pour chacun d'eux. Et les comparer afin d'avoir la plus récente sur l'ensemble des articles!
 
Merci encore

n°2082225
tarteflamb​ee
Posté le 13-06-2011 à 22:21:28  profilanswer
 

Bonjour,

 

Je ne sais pas si j'ai tout compris:
tu as ca:
http://hfr-rehost.net/self/pic/2cb134f962a5fe375d2c956f9befe0fac11d65ce.jpeg

 

et tu veux ca (pour chaque objet la date la + ancienne):
http://hfr-rehost.net/self/pic/42d93214d7879bd47e4fbdbd85ee980c2710e6aa.jpeg

 

pour 100 objets différents sur 10000 dates différentes ca me prends une seconde  :o :
Il faut cocher Microsoft Scripting Runtime dans Outils>Références

Citation :

Sub D_DatesDebutMsn2()

 

Dim i As Integer
Application.ScreenUpdating = False
Worksheets("Feuil3" ).Range("A:B" ).ClearContents
Worksheets("data" ).Columns("D:G" ).NumberFormat = "General"
LastRow = Worksheets("data" ).Cells(65536, 2).End(xlUp).Row
Dim vMsn As Variant
Dim dico As New Scripting.Dictionary
Dim temp As String
Dim Last_date As Date
Dim Last_objet As String

 

With ThisWorkbook.Worksheets("data" )
    For i = 2 To LastRow
        If StrComp(.Cells(i, 8).Value, "Oui", vbTextCompare) = 0 And .Cells(i, 6).Value > 0 Then
            'date la + ancienne pour chaque objet
            If dico.Exists(CStr(Worksheets("data" ).Cells(i, 2).Value)) = False Then
                'on ajoute dnas le dico l'objet inexistant
                dico(CStr(Worksheets("data" ).Cells(i, 2).Value)) = CStr(Format(.Cells(i, 6).Value, "yyyymmdd" ))
            Else
                'on compare la nouvelle date et celle dans le dico
                If Val(CStr(Format(.Cells(i, 6).Value, "yyyymmdd" ))) < Val(dico(CStr(Worksheets("data" ).Cells(i, 2).Value))) Then
                    'on change la date pour la + recente dans le dico
                    dico(CStr(Worksheets("data" ).Cells(i, 2).Value)) = CStr(Format(.Cells(i, 6).Value, "yyyymmdd" ))
                End If
            End If
            If CDate(.Cells(i, 6)) > Last_date Then
                Last_date = CDate(.Cells(i, 6))
                Last_objet = .Cells(i, 2).Value
            End If
           
        End If
       
    Next i
End With
Worksheets("data" ).Columns("D:G" ).NumberFormat = "m/d/yyyy"
With Worksheets("Feuil3" )
'extraction du resultat
    i = 1
    For Each vMsn In dico.Keys
       .Cells(i, 1).Value = vMsn
       temp = dico(vMsn)
       .Cells(i, 2).Value = CDate(DateSerial(Left(temp, 4), Mid(temp, 5, 2), Right(temp, 2)))
        i = i + 1
    Next vMsn
    Set dico = Nothing
    Application.ScreenUpdating = True
End With

 

End Sub

 

L'objet le + recent est dans la variable last_object et sa date dans last_date

 

J'ai peut-être un peu compliqué avec les formats  [:transparency]  Je fait toujours ca pour être sur que ca marche  :o


Message édité par tarteflambee le 13-06-2011 à 22:35:42
n°2082406
Rizlonggra​in
Posté le 14-06-2011 à 18:44:08  profilanswer
 

Bonjour,
 
C'est exactement ça, merci beaucoup! Je ne connaissais pas les "dico", c'est en effet bien plus rapide qu'avec un programme classique!
Du coup je vais étudier ça de plus près, ça pourrait me servir!
 
Merci encore, bonne soirée
Antoine


Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  Boucles for imbriquées, macro trop lente

 

Sujets relatifs
Macro de copie + son audio.Boucle à faire dans macro VBA (Excel)
Besoin d'aide pour macro simple mais efficace !!créer une macro recherche sur excel
Inserer des renvoi dans un doc word via une macro VB excelmacro pour enregister le classeur et le fermer
CREATION Macro CATIA sous UNIX type .CATVBA[VBA] Macro Introuvables/Inactives, pourtant ça tourne....Excel 2010
Probleme boucles bashMacro VBA sous excell et fonction RTD
Plus de sujets relatifs à : Boucles for imbriquées, macro trop lente


Copyright © 1997-2022 Hardware.fr SARL (Signaler un contenu illicite / Données personnelles) / Groupe LDLC / Shop HFR