Boucles for imbriquées, macro trop lente

Recherche :

Mot : Pseudo : Filtrer
Bas de page
Auteur	Sujet : Boucles for imbriquées, macro trop lente

Rizlonggrain

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 :

Sub D_DatesDebutMsn()
Application.ScreenUpdating = False
Worksheets("Feuil3" ).Range("A:B" ).ClearContents
Worksheets("data" ).Columns("D:G" ).NumberFormat = "General"
LastRow = Worksheets("data" ).Range("A60000" ).End(xlUp).Row
For i = 2 To LastRow
If Worksheets("data" ).Cells(i, 8).Value = "Oui" Then
first = Worksheets("data" ).Cells(i, 6).Value
vMsn = Worksheets("data" ).Cells(i, 2).Value
For j = 2 To LastRow
If j <> i Then
If Worksheets("data" ).Cells(j, 2).Value = Worksheets("data" ).Cells(i, 2).Value Then
If Worksheets("data" ).Cells(j, 6).Value < Worksheets("data" ).Cells(i, 6).Value Then
If Worksheets("data" ).Cells(j, 6).Value > 0 Then
first = Worksheets("data" ).Cells(j, 6).Value
vMsn = Worksheets("data" ).Cells(j, 2).Value
End If
End If
End If
End If
If first <> 0 Then
Worksheets("Feuil3" ).Cells(i, 1).Value = vMsn
Worksheets("Feuil3" ).Cells(i, 2).Value = first
End If
Next j
End If
Next i
Worksheets("data" ).Columns("D:G" ).NumberFormat = "m/d/yyyy"
Worksheets("Feuil3" ).Columns("B:B" ).NumberFormat = "m/d/yyyy"
Application.ScreenUpdating = True
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 !

Publicité

billgatesanonym

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.

Rizlonggrain

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

tarteflambee

Bonjour,

Je ne sais pas si j'ai tout compris:
tu as ca:

et tu veux ca (pour chaque objet la date la + ancienne):

pour 100 objets différents sur 10000 dates différentes ca me prends une seconde :
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

Message édité par tarteflambee le 13-06-2011 à 22:35:42

Rizlonggrain

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

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 excel	macro 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 bash	Macro VBA sous excell et fonction RTD
Plus de sujets relatifs à : Boucles for imbriquées, macro trop lente

Page générée en 0.051 secondes