Boucles for imbriquées, macro trop lente

Boucles for imbriquées, macro trop lente - VB/VBA/VBS - Programmation

Marsh Posté le 12-06-2011 à 19:46:56    

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

Reply

Marsh Posté le 12-06-2011 à 19:46:56   

Reply

Marsh Posté le 13-06-2011 à 08:41:02    

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.

Reply

Marsh Posté le 13-06-2011 à 17:57:54    

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

Reply

Marsh Posté le 13-06-2011 à 22:21:28    

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
Reply

Marsh Posté le 14-06-2011 à 18:44:08    

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

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed