macro trop lente

pasquetp

XLDnaute Occasionnel
Bonjour a tous,

je tente de faire une macro mais elle prend bien trop de temps

voici le code que j'emploie:

Sub Macro2()

Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual

fin = Sheets("error-report").Range("b65536").End(xlUp).Row


For a = 6 To fin

If Sheets("error-report").Cells(a, 7) <> "" Then

Set SKU = Sheets("data").Columns(1).Find(Sheets("error-report").Cells(a, 2), LookIn:=xlValues, LookAt:=xlWhole)


If Not SKU Is Nothing Then

'aie = MsgBox("sku" & Sheets("error-report").Cells(a, 2) & " not found", vbCritical, "SKU not found")
'Exit Sub


Set Column = Sheets("data").Rows(3).Find(Sheets("error-report").Cells(a, 7), LookIn:=xlValues, LookAt:=xlWhole)
If Not Column Is Nothing Then
' aiee = MsgBox("column " & Sheets("error-report").Cells(a, 7) & " not found", vbCritical, "SKU not found")
' Exit Sub

Sheets("data").Cells(SKU.Row, Column.Column).Interior.Color = 16711935

End If

End If
End If
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomati
End Sub

*********************************

l'objectif de la macro:

que en page data la cellule qui fait l'intersection de la ligne x et de la colonne y soit mis en couleur

le x est determiné en page error report colonne B et le y en page error report colonne G

je mets donc un for next pour faire une boucle

jai fait un essai avec 5000 sku en page 1 et page 2 : ca a mis + de 10 minutes.

Je dois a tout prix reduire le temps

quelqu'un aurait une idée ou un code tout a fait different poiur reduire ce temps?

Merci a tous
 

Pièces jointes

  • Classeur3.xlsm
    121.5 KB · Affichages: 66
  • Classeur3.xlsm
    121.5 KB · Affichages: 66
  • Classeur3.xlsm
    121.5 KB · Affichages: 67

Dranreb

XLDnaute Barbatruc
Re : macro trop lente

Bonsoir.
Chargez déjà, au début, par deux instructions, tous les SKU et types de produits de error-report dans des tableaux de variant, pour ne plus avoir à déranger Excel par la suite pour chacune de ses lignes.
Faite pareil pour la colonne A de data, mais explorez aussitôt cette table et ajoutez ses éléments à un Dictionary avec comme Key la valeur et comme Item le numéro de ligne.
Pareil pour la ligne 3 sauf que ce sont les numéros de colonne qu'il faut prendre comme item.
Il ne reste plus qu'à explorer les lignes des tables chargées au début, et colorer les Cells(DicoL(SHU(L)), DicoC(Tit(L)).
Mettez peut être aussi la plage résultante dans une variable Range pour ne pas forcer Excel à entreprendre, pour chaque cellule à colorer, la recherche de "data" dans la collection Sheets du classeur (ce qui ramène d'ailleurs un objet banalisé Object, avec liaison tardive, donc, vers la méthode Cells, au lieu d'un objet Worksheet).

Pour avoir du code rapide il faut mettre toutes les chances de son coté et demandez le moins de choses possible à Excel. Du moins en nombre de fois qu'on lui demande quelque chose. Toujours grouper les demandes autant que possible: Il est plus rapide de charger la Value d'un Range de 10000 cellules dans un tableau de variant que de demander seulement 50 fois la valeur d'une seule cellule à chaque coup.
 
Dernière édition:

pasquetp

XLDnaute Occasionnel
Re : macro trop lente

Bonjour,

Merci de vos lumières

J'ai compris votre explication c'est vraiment bien expliqué :)

je suis complètement d'accord que grouper en une fois va diminuer le temps. dans mon code le systeme n'arrete pas de les faire un par un et ca fait "ramer" donc je vais faire le max pour le laisser tranquil.

je n'ai jamais tenté des tableaux de variants. je vais tenter de me documenter en trouvant des exemples. si j'ai besoin d'aide je vous recontacte; j’apprécie votre aide.

Merci milles fois

Pierre
 

Dranreb

XLDnaute Barbatruc
Re : macro trop lente

Non, ce n'est pas complexe.
Un tableau de Variant se déclare simplement
VB:
Dim MonTableau()
Et on peut directement lui affecter la propriété Value d'une expression Range couvrant plusieurs cellules contigües.
Elle se retrouve alors toujours à 2 dimensions même pour une seule ligne ou une seule colonne
Ubound(MonTableau, 1) donne le nombre de lignes, Ubound(MonTableau, 2) le nombre de colonnes.
MonTableau(L, C) représente l'élément du tableau à la ligne L, colonne C.
 

laetitia90

XLDnaute Barbatruc
Re : macro trop lente

bonjour tous :):)

comme je comprends?? essai deja comme cela.... on verra aprés pour optimiser

Code:
Sub es()
 Dim t(), i As Long, m As Object
 Application.ScreenUpdating = 0
 Application.Calculation = xlCalculationManual
 Set m = CreateObject("Scripting.Dictionary")
 t = Feuil1.Range("b6:g" & Feuil1.Cells(Rows.Count, 2).End(3).Row)
 For i = 1 To UBound(t)
 If Not m.Exists(t(i, 1)) And t(i, 6) <> "" Then m.Add t(i, 1), t(i, 1)
 Next i
  With Feuil2
  For Each c In .Range("a4", .Cells(Rows.Count, "a").End(3))
   If m.Exists(c.Value) Then c.Offset(, 7).Interior.Color = 16711935
  Next c
 End With
 Application.ScreenUpdating = 1
 Application.Calculation = xlCalculationAutomatic
 Erase t: Set m = Nothing
 End Sub
 

pasquetp

XLDnaute Occasionnel
Re : macro trop lente

Bonjour laetitia90


C'est magnifique, ca met moins de 5 seconde pour 5000

Un tres grand merci

ce type de code m'interesse beaucoup

Connaitriez vous un site où je peux apprendre et "m'exercer"

Encore une fois un grand Merci :)
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : macro trop lente

Bonne année à pasquetp, Dranreb, laetitia90 :)

Un autre essai qui permet les doublons de item_SKU dans la feuille "error-report". Le code est un peu plus complexe que celui de laetitia90 (comme à mon habitude :eek:). Je n'ai pas pu comparer les vitesses car le code de laetitia90 bogue chez moi (va falloir m'y plonger). le code est dans module1.

VB:
Option Explicit
Sub VroumVroum()
Dim dicoSKU As Object, dicoTypeProd As Object, dicoRes As Object
Dim tablo, i&, i2&, j&, j2&, k, k2&, tSKU, tTypeProd
Dim ligne, colonne, xrg As Range, t0

  With Sheets("data")
  ' effacement des couleurs de fond précédentes
  Set xrg = Intersect(.UsedRange, .Range("b4").Resize(100000, 10000))
  xrg.Interior.ColorIndex = xlColorIndexNone
  Set xrg = Nothing
  
  ' pour les test : permet d'effacer les couleurs des cellules de data
  ' sans devoir faire le taitement
  If Not (MsgBox("RAZ des couleurs des cellules de DATA faite. Continuer ?", _
      vbQuestion + vbYesNo + vbDefaultButton2) = vbYes) Then Exit Sub
  
  Application.ScreenUpdating = False
  t0 = Timer
  
  ' Acquisition de dicoSKU (key = colonne A de DATA) (Item = ligne de Key)
  Set dicoSKU = CreateObject("scripting.dictionary")
  tablo = .Range(.Range("A4"), .Range("A" & Rows.Count).End(xlUp)).Value
  i2 = UBound(tablo)
  For i = 1 To i2
    If Not dicoSKU.exists(tablo(i, 1)) Then dicoSKU(tablo(i, 1)) = i + 3
  Next i
  
  ' Acquisition de dicoTypeProd
  ' (key = ligne 3 de l'article produit) (Item = colonne de article produit)
  Set dicoTypeProd = CreateObject("scripting.dictionary")
  tablo = .Range(.Range("b3"), .Cells(3, Columns.Count).End(xlToLeft)).Value
  j2 = UBound(tablo, 2)
  For j = 1 To j2
    If Not dicoTypeProd.exists(tablo(1, j)) Then dicoTypeProd(tablo(1, j)) = j + 1
  Next j
End With

With Sheets("error-report")
  ' Acquisition des tablraux tSKUet tTypeProd (de la source)
  tSKU = .Range(.Range("b6"), .Range("b" & Rows.Count).End(xlUp)).Value
  tTypeProd = .Range(.Range("b6"), .Range("b" & Rows.Count).End(xlUp)).Offset(, 5).Value
  i2 = UBound(tSKU)
End With

 ' initialisation de dicoRes
 ' dicoRES est dictionnair:
 ' dont les cles sont les numéros de ligne dans data des SKU de la source
 ' pour une clef donnée, l'item est un dictionnaire
 ' ce dictionnaire comprend les numéros de colonnes qui seront à colorier
 ' donc:
 ' une clef de dicoRES donne un numero de ligne de la feuille DATA
 ' l'item associée à cette clef donne un dictionnaire dont les cles sont les
 ' numéro de colonnes à colorier.
 Set dicoRes = CreateObject("scripting.dictionary")
 
 ' remplissage dicoRes
 For i = 1 To i2
  If tSKU(i, 1) <> "" And tTypeProd(i, 1) <> "" Then
    ' ni SHU de la source, ni TypeProd de la source ne sont vides
    If dicoSKU.exists(tSKU(i, 1)) And dicoTypeProd.exists(tTypeProd(i, 1)) Then
      ' le SHU de la source et le TypeProd de la source sont présents sur DATA
      If Not dicoRes.exists(dicoSKU(tSKU(i, 1))) Then
        ' C'est la première fois qu'on rencontre une ligne dans DAT pour un SKU
        ' On crée un élément dans dicoRES
        Set dicoRes(dicoSKU(tSKU(i, 1))) = CreateObject("scripting.dictionary")
        ' on ajoute la clef dicoSKU(tSKU(i, 1)) (c'est la ligne de SKY dans data)
        dicoRes(dicoSKU(tSKU(i, 1)))(dicoTypeProd(tTypeProd(i, 1))) = Empty
      Else
        ' La ligne de SKU dans data existe déjà dans dicoRES,
        ' on rajoute le numéro de colonne de typeprod comme clef
        dicoRes(dicoSKU(tSKU(i, 1)))(dicoTypeProd(tTypeProd(i, 1))) = Empty
      End If
    End If
  End If
Next i
          
' Changement de couleur des cellules (ligne par ligne)
  With Sheets("data")
     For Each ligne In dicoRes.keys
      For Each colonne In dicoRes(ligne).keys
        If xrg Is Nothing Then Set xrg = .Cells(ligne, colonne) Else Set xrg = Union(xrg, .Cells(ligne, colonne))
      Next colonne
    Next ligne
    xrg.Interior.Color = 16711935
  End With
  MsgBox "C'est fini !  (" & Format(Timer - t0, "#,##0.00") & " sec. )"
  Application.Goto Sheets("data").Range("a1"), True
  Application.ScreenUpdating = True
End Sub
 

Pièces jointes

  • pasquetp (01b).xlsm
    132 KB · Affichages: 53
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : macro trop lente

RE,

Une version plus rapide qui n'utilise pas la fonction UNION pour la mise en couleur des cellules.
(environ 5214 SKU sur la Feuille "error-report" et 5210 SKU sur la Feuille "data")

La partie du code qui a changé:
VB:
' Changement de couleur des cellules (ligne par ligne)
  Dim S$(), N&, MAX&
  MAX = 20
  With Sheets("data")
     ReDim S(1 To MAX): N = 0
     For Each ligne In dicoRes.keys
      For Each colonne In dicoRes(ligne).keys
        N = N + 1
        S(N) = .Cells(ligne, colonne).Address(0, 0)
        If N = MAX Then
          .Range(Join(S, ",")).Interior.Color = 16711935
          ReDim S(1 To MAX): N = 0
        End If
      Next colonne
    Next ligne
    If N <> 0 Then
      ReDim Preserve S(1 To N)
      .Range(Join(S, ",")).Interior.Color = 16711935
    End If
  End With
 

Pièces jointes

  • pasquetp (01d).xlsm
    204.9 KB · Affichages: 50

pasquetp

XLDnaute Occasionnel
Re : macro trop lente

mapomme c'est de la magie

votre code est excellent (je ne code pas aussi bien que vous) et c'est EXACTEMENT ce que je souhaite

raaaaah un grand merci a vous car je sais que ca a du vous prendre du temps (reflexion + taper le code et controler)

j'apprécie ce que vous avez fait pour moi

je veux apprendre a coder comme vous

auriez vous des conseils, sites specialisé sur ce type de code

***'CreateObject("scripting.dictionary")'
***UBound(tablo, 2) (j'ai déjà vu cela dans des discussions et j'ai du mal à le comprendre: ca m'a l'air d'un code très puissant: si vous avez un site specialisé dessus je suis preneur


je vois que vous avez mis des commentaires en vert et c'est le top du top

j'ai pas encore pu les lire (je suis au boulot) je verrai les commentaires a la maison

Merci encore :) :) :)
 

Dranreb

XLDnaute Barbatruc
Re : macro trop lente

Bonjour.

Conseil: Cochez plutôt "Microsoft Scripting Runtime" dans la liste Références disponibles, menu Outils, Références.
Vous pourrez ainsi au lieu de As Object les déclarer As Dictionary, et vous aurez, dès la frappe du point derrière le nom des variables de ce type, la suggestion des méthodes et propriétés utilisables.
Sans compter un code très très légèrement plus rapide et pouvoir mettre simplement New Dictionary au lieu de CreateObject("Scripting.Dictionary")
 
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : macro trop lente

Bonsoir à tous,

J'ai suivi les préconisations de Dranreb et déclaré les variables de type dictionnaire directement en type dictionary et non comme object. Il faut donc maintenant avant de lancer la macro avoir référencé Microsoft Scripting Runtime.

En performance, je passe d'une moyenne de 1,66 sec. en temps d'exécution pour la version v01d (déclaration as object) à un temps moyen de 1,57 pour la version v01e (déclaration as dictionary), soit -5,4%. Dranreb avait (bien évidemment) raison :).

J'en ai profité pour rajouter un onglet "Principe" où je tente, bien maladroitement ma foi, de présenter le principe sur lequel repose le codage de la macro.

Le fonctionnement nécessite l'activation de la référence à "Microsoft Scripting Runtime". Pour cela:

  • Se placer dans l'éditeur VBA (touches Alt+F11)
  • Sélectionner le menu "Outils / Références..."
  • Dans la boîte de dialogue, chercher "Microsoft Scripting RunTime"
  • Cocher la case correspondante (si ce n'est pas déjà le cas) puis cliquer sur "OK"
 

Pièces jointes

  • pasquetp (01e).xlsm
    240.3 KB · Affichages: 63
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : macro trop lente

Bonsoir pasquetp
(...) je veux apprendre a coder comme vous (...) auriez vous des conseils, sites specialisé sur ce type de code (...)
Tout d'abord, avant de crier victoire, il faut vérifier que le code fait bien ce que vous voulez qu'il fasse. Il y a peut-être des situations que je n'ai pas prévues qui peuvent entrainer un résultat erroné, situations auxquelles vous seul serait confronté.

Quand à apprendre à coder (et je suis sans doute loin d'être un exemple dans ce domaine), j'ai peu de références à vous donner.
Mon parcours m'a amené à coder dans de nombreux langages tant dans ma vie estudiantine que professionnelle. J'ai donc pu profiter d'un enseignement de qualité et de collègues expérimentés et prévenants pour progresser. A l'époque, les logiciels étaient accompagnés d'une documentation conséquence (plusieurs KG !). Je lisais tous les volumes de la doc de A à Z. Même si je ne retenais que très peu, quand j'avais besoin d'une notion inconnue ou pas encore utilisée, je savais que je l'avais vue et me replongeait dans la doc. Aujourd'hui avec la documentation en ligne, j'ai plus de mal à retenir ce que j'ai lu ou plutôt vu (c'est peut-être aussi à mettre sur le compte des années qui passent et s'empilent :rolleyes:). Heureusement, il y a Google.

Il reste que j'ai abandonné la programmation quelques années et pour m'y remettre (par exemple en VBA):
j'ai parcouru quelques forum Excel (Microsoft.answers [version anglaise], Excel-pratique et enfin XLD), choisissant des problèmes soumis par les forumeurs et tentant de trouver une solution par moi-même. Cette solution perso, je la comparais aux solutions proposées sur le forum. Avec cette méthode, on progresse assez vite, on découvre des notions nouvelles et aussi des "tours de mains" nouveaux.

Avec en soutien, une recherche via gogol qui aboutit bien souvent à des sites expliquant bien les choses (et fréquemment avec exemple). On va forcément retrouver en tête de résultat de la recherche tous les sites connus de qualité (comme par exemple excelabo). Si on manie un peu l'anglais, ne pas négliger les sites en langage grand breton. On en trouve de remarquables aussi. Pour travaux pratiques, testez google avec les termes "dictionary" ou "Excel dictionary"

Il y l'aide d'Excel VB que je trouve bien faite (en Excel 2010 du moins)

Avec Excel VBA, il y a des outils de débogage assez intéressants : le pas à pas, les points d'arrêts, les espions, la fenêtre d'exécution. Ces outils peuvent servir à rechercher des erreurs mais aussi à bien comprendre le code d'une tierce personne.

Quand aux ouvrages, il y en a certainement de très bons mais je n'en connais point.

Et enfin, le dernier point, codez, codez et codez, le temps est aussi votre ami (c'est peut-être ce qu'on appelle "l'expérience" - qui va souvent aussi de pair avec les mauvaises habitudes, surtout en codage).

Et si vous êtes bloqués, XLD (ou d'autres forum, soyons honnêtes) est là.

A+
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 892
Membres
101 831
dernier inscrit
gillec