Vous utilisez un navigateur obsolète. Il se peut que ce site ou d'autres sites Web ne s'affichent pas correctement. Vous devez le mettre à jour ou utiliser un navigateur alternatif.
XL 2013VBA Macro temps d'execution trop lent (Dates + heures en couleurs)
Bonjour le forum en espérant que tout le monde va bien!
Je reviens vers vous avec un problème de temps d’exécution de macro.
Je dois remplir des cases de couleurs (12 couleurs en tout) correspondant aux dates d'un tableau structuré.
Je souhaiterai passé par le VBA car avec des MFC et SOMMEPROD ça rame beaucoup trop!
Merci d'avance pour votre disponibilité vos lumières!
PMG
VB:
Sub Couleur()
Dim i As Variant, j As Variant, k As Variant
Application.ScreenUpdating = False
Call Effacer
For k = Range("Tableau1[#ALL]").Rows.Count To 1 Step -1 'Tableau
For i = 16 To 46 'Dates
For j = 6 To 57 'Heures
If Cells(i, 4).Value + Cells(11, j).Value >= Range("Tableau1[Début]").Rows(k).Value And Cells(i, 4).Value + Cells(11, j).Value < Range("Tableau1[Fin]").Rows(k).Value Then
Cells(i, j).Interior.ColorIndex = Range("Tableau1[Code]").Rows(k).Value
Cells(i, j).Value = Range("Tableau1[Code1]").Rows(k).Value
Cells(i, j).Font.ColorIndex = Range("Tableau1[Code]").Rows(k).Value
End If
Next j, i, k
End Sub
Pour le FUN :
En prenant le problème à l'envers, on ne fait qu'une seule boucle principale sur le tableau structuré des tâches.
C'est très rapide sur ma bécane. En moyenne 0,005 seconde (testé sur 1000 exécutions - voir la macro TestExcec() ).
La macro de mise en couleur est Colorier() dans le module de Feuil1.
Attention ! Pour la journée du 26 mai 2020, les trois plages se chevauchent. Si les trois couleurs sont différentes pour les trois plages, on arrive à une aberration au niveau coloriage.
J'ai ôté la boucle de la macro Effacer().
Le code:
VB:
Sub Colorier()
Dim ti, t, tDates, KO As Boolean, i&, ligne&, colA&, colB&
ti = Timer: Application.ScreenUpdating = False
Effacer
t =...
Bonjour
Je n'ai pas (je ne le fais jamais) ouvert ton classeur
Les boucles imbriquées que tu utilises sont forcément gourmandes en temps d'exécution.
Tu pourrais parcourir des matrices des plages concernées plutôt que les plages elles-mêmes
ceci dit :
type convenablement tes variantes :
VB:
Dim i As Integer, j As Integer, k As Long
évite de contrôler systématiquement, comme tu le fais deux expressions . n e contrôle la seconde que si la première est avérée (tu gagneras quelques centièmes de secondes à chaque itération) : --->>
Code:
If Cells(i, 4).Value + Cells(11, j).Value >= Range("Tableau1[Début]").Rows(k).Value Then
If Cells(i, 4).Value + Cells(11, j).Value < Range("Tableau1[Fin]").Rows(k).Value Then
Bonjour PMG, Jmfmarques,
Pour accélérer une macro, une méthode radicale est de tout passer en array.
Ici, sur mon PC, on passe de 5.4 s à 0.15 s. Soit 36 fois plus rapide.
C'est la différence entre accéder à une cellule et accéder à un élément d'array.
Par contre bien vérifier, car je me suis attaché à accélérer sans vérifier à fond que tout est ok.
Bonjour le forum, Jmfmarques, Sylvanu,
Merci pour vos réponses!
#Jmfmarques
Merci pour tes remarques constructives à intégrer ds mes codes. Effectivement je gagne un peu de temps.
#Sylvanu
Merci bcp pour ta macro "CouleurNew". Efficacité redoutable!
Il me semblais bien qu'avec les arrays, comme j'ai pu le lire souvent on change radicalement de méthode. Pas évident par contre à comprendre sans des exemples concrets.
Peux tu stp m’expliquer cette ligne:
VB:
tablo2 = Range(Cells(1, 1), Cells(50, 60)) ' Transfert zone (1,1)(50,60) dans array tablo2
Cells(1,1) intégration de la première case du "tablo2"?
Cells(50,60) intégration de la dernière case du "tablo2"? Si oui je peux mettre le nombre de lignes, colonnes exacts soit: Cells(31,52)
Comment déclarer un tableau non structuré et variable:
Code:
Dim tablo()
DL = Range("BI10").End(xlDown).Row
ReDim tablo(DL - 10, 3)
For k = 0 To DL - 10
'Code
If tablo2(i, 4) + tablo2(11, j) >= tablo(k, 1) Then
'Code'
Bonjour,
Je ne voulais pas déstructurer votre macro, ce n'était pas le but, aussi j'ai opté pour ne pas changer vous indices i,j,k de transférer l'ensemble de la plage commençant en A1 :
VB:
tablo2 = Range(Cells(1, 1), Cells(50, 60))
revient à transférer Range("A1:BH50") dans un array.
De cette façon i et j restent identiques.
Vous pouvez simplifier la zone à transférer F16:BE46, mais comme la première cellule du tableau sera transférer dans la première cellule de l'array, il vous faudra modifier i et j : de 1 à 10 et de 1 à 51, mais aussi de tout revérifier.
Ensuite vous pouvez redimensionner le tablo à votre convenance, ou simplement le transférer dans un tablo non redimensionner puis utiliser Ubound pour connaitre sa taille.
Par contre dans votre code, après le Redim, il faut faire le transfert tablo=....
Le Redim ne fait que la réservation mémoire.
Pour le FUN :
En prenant le problème à l'envers, on ne fait qu'une seule boucle principale sur le tableau structuré des tâches.
C'est très rapide sur ma bécane. En moyenne 0,005 seconde (testé sur 1000 exécutions - voir la macro TestExcec() ).
La macro de mise en couleur est Colorier() dans le module de Feuil1.
Attention ! Pour la journée du 26 mai 2020, les trois plages se chevauchent. Si les trois couleurs sont différentes pour les trois plages, on arrive à une aberration au niveau coloriage.
J'ai ôté la boucle de la macro Effacer().
Le code:
VB:
Sub Colorier()
Dim ti, t, tDates, KO As Boolean, i&, ligne&, colA&, colB&
ti = Timer: Application.ScreenUpdating = False
Effacer
t = Range("Tableau1").Value 'les plages des taches
tDates = Range(Cells(16, "d"), Cells(Rows.Count, "d").End(xlUp)).Value2 'les dates en colonne D
For i = 1 To UBound(t)
If t(i, 1) = "" Then Exit For 'si cellule 1ère colonne vide
For ligne = 1 To UBound(tDates)
If tDates(ligne, 1) = Int(t(i, 2)) Then Exit For
Next ligne
If ligne > UBound(t) Then KO = True
ligne = ligne + 15 ' la ligne concernée
colA = 6 + 4 * (Format(t(i, 2), "hh") - 8)
colA = colA + Int(Format(t(i, 2), "nn") / 15) ' la colonne de début
colB = 6 + 4 * (Format(t(i, 3), "hh") - 8)
colB = colB + Int(Format(t(i, 3), "nn") / 15) - 1 ' la colonne de fin
With Range(Cells(ligne, colA), Cells(ligne, colA)).Resize(, colB - colA + 1)
.Interior.ColorIndex = t(i, 1) ' Mise en forme
.Font.ColorIndex = t(i, 1)
.Value = t(i, 4)
End With
Next i
Range("w5") = Format(Timer - ti, "0.000\ sec.")
End Sub
edit : j'avais commencé à faire des vérifs et puis j'ai renoncé (d'où la scorie du KO)
Merci sylvanu pour le fichier, effectivement c'est le jour et la nuit. Il va falloir que je revoie tout mon fichier pour essayer de travailler avec des arrays seulement! J'avoue que c'est impressionnant de voir le traitement quasi instantané des données.
Merci mapomme pour cette autre solution (ps: problème de téléchargement chez moi!), en tout cas je l'ai collé dans un module pour essayer! Effectivement il y a une erreur pour la journée du 26/05/20 les plages ne doivent pas se chevaucher. Bravo pour la rapidité! Hallucinant! Et dire que hier j'étais content avec les 5 sec de ma macro de débutant!
Rassure toi. Quand j'ai commencé, mes codes était longs également (enfin 5 secondes, c'est pas énorme non plus). A force de remettre son ouvrage sur le métier et de "piquer" les bonnes pratiques aux autres, on progresse.
Je vais voir pour reconstruire le fichier et remplacer le défaillant.
Bonjour
En français, je préfère personnellement utiliser le mot matrice ou encore tableau.
Cette dénomination permet d'éviter toute confusion avec la fonction Array qui, elle, retourne un tableau de valeurs variant à une une seule dimension et a le mérite de correspondre à l'idée que l'on se fait de la chose.
Merci pour le test du fichier. Je vais aussi remplacer le fichier de mon premier message.
ColA sera le numéro de la colonne à partir de laquelle on doit appliquer la mise en forme de couleur.
Cette colonne va dépendre de l'heure de début de la tâche (heure et minute).
Notons qu'une colonne du planning correspond un quart d'heure (15mm). Il faudra tenir compte de cette modularité.
VB:
colA = 6 + 4 * (Format(t(i,2), "hh") - 8)
L'instruction Format ressemble à la fonction Texte d'Excel mais pour une utilisation en VBA
Contrairement à Texte(...) en Excel, la fonction Format en VBA utilise la notation américaine.
Format(valeur, format_texte as string): Format renvoie un résultat de type string. Format renvoie une valeur indiquée dans le premier argument avec le format précisé par le deuxième argument.
Quelques exemples :
x est une date qui vaut Cdate("13/04/2023 15:12:31") :
Format( x, "dd mmm yy" ) retourne le texte "13 avr 23"
Format( x, "dd-m-yy hh:mm" ) retourne le texte "13-4-23 15:12"
Format( x, "dd mmmm yyyy hh:mm" ) retourne le texte "13 avril 2023 15:12"
Notation américaine : année -> y, mois -> m, jour -> d, heure ->h, minute -> m, seconde -> s.
Il peut y avoir une ambiguïté entre le m du mois et le m de minute que VBA ne peut pas toujours lever.
Dans ce cas, on indique les minutes par la lettre n.
Format(x, "mm-yy hh:mm") retourne le texte "04-23 15:12"
Format(x, "mm-yy mm") retourne le texte "04-23 04"
Format(x, "mm-yy nn") retourne le texte "04-23 12"
Idem pour pour des nombres. Prenons y = 12456,789 :
format (y , "#,##0.00") retourne le string "12 456,79"
format (y , "000,000.0") retourne le string "012 456,8"
format (y , "0.00") retourne le string "12456,79"
Notation américaine : le séparateur de millier est la virgule, le séparateur décimal est le point.
Revenons à nos moutons :
Code:
colA = 6 + 4 * (Format(t(i,2), "hh") - 8)
On prend la date et l'heure de début t(i,2). Par un format(), on extrait une chaine de type string qui est l'heure sous forme de 2 chiffres Format(t(i, 2), "hh")
Comme c'est du texte, on devrait le transformer en nombre Int(...) [on utilise la faculté de VBA qui convertit automatiquement en nombre tout string engagé dans un calcul - ce n'est est pas bien de faire ça d'un point de vue codage]. Mais je l'ai fait quand même et j'ai honte.
Dans une heure, il y a 4 quarts d'heure. On doit multiplier par 4 pour avoir le nombre de quarts d'heure correspondant à t(i,2).
Ce nombre de quart d'heure est en fait le nombre de quarts d'heure écoulés depuis 0h.
Or le planning commence à 8h00. Ce qui nous intéresse donc, c'est le nombre de quart d’heure depuis 8h00 et pas depuis minuit (ou 00h00). Il faut donc retirer 4 * 8 quarts d'heure au nombre précédent, ce qui donne 4 * Format(t(i,2), "hh") - 4 * 8 soit encore 4 * ( Format(t(i,2), "hh") - 8)
Ce nombre de quart d'heure correspond au nombre de quarts d'heure écoulés depuis 8h00
La colonne correspondant à 8h00 est la colonne F du planning (colonne n° 6). Donc le numéro absolu de la colonne ( pour l'heure correspondant à t(i,2) ) est : 6 + 4 * (Format(t(i,2), "hh") - 8)
Exemple :
11h00 : la colonne correspondant à cette heure est la colonne 6 + 4 * (11 - 8) soit 18 (soit la colonne R du planning)
17h00 : la colonne correspondant à cette heure est la colonne 6 + 4 * (17 - 8) soit 42 (soit la colonne AP du planning)
Code:
ColA = colA + Int(Format(t(i, 2), "nn") / 15)
Mais nous n'avons pas tenu compte des minutes. Pour cela :
on extrait les minutes : Format(t(i, 2), "nn")
on divise les minutes par 15
on en prend la partie entière qui est soit 0, 1, 2, ou 3.
A la colonne trouvée précédemment, il faut ajouter le nombre de quart d'heure depuis l'heure.
11h00: la partie entière de int(00/15) est 0. On rajoute 0 à la colonne ColA, ce qui donne colonne 18 (18+0). La colonne de départ pour la mise en forme de la ligne est la colonne 18 soit R
11h15: la partie entière de int(15/15) est 1. On rajoute 1 à la colonne ColA, ce qui donne colonne 19 (18+1). La colonne de départ pour la mise en forme de la ligne est la colonne 19 soit S
11h45: la partie entière de int(45/15) est 3. On rajoute 3 à la colonne ColA, ce qui donne colonne 21 (18+3). La colonne de départ pour la mise en forme de la ligne est la colonne 21 soit U
notez que ça fonctionne aussi si les minutes ne sont pas multiples de 15
Merci pour ce cours de VBA avec ces explications détaillées et pour le temps que tu as dû y consacrer!
Archivé!
J'ai bien compris ta démarche, enfin je crois!
1/ La case en rouge du tableau ("F13") affiche 8:00h, à la base je pouvais la modifier pour ajuster le planning si la plage horaire totale passe à 9:00h 21:00h.
Donc, je modifie par 9 car 9 * 4 (1/4d'heure).
Ce site utilise des cookies pour personnaliser le contenu, adapter votre expérience et vous garder connecté si vous vous enregistrez.
En continuant à utiliser ce site, vous consentez à notre utilisation de cookies.
, 
