XL 2013 VBA Macro temps d'execution trop lent (Dates + heures en couleurs)

PMG

XLDnaute Junior
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
 

Pièces jointes

  • VBA Couleurs et dates.xlsm
    33.4 KB · Affichages: 27
Solution
Bonjour @PMG :), @sylvanu ;),

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 =...

jmfmarques

XLDnaute Accro
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
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
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.
 

Pièces jointes

  • VBA Couleurs et dates(V2).xlsm
    35.7 KB · Affichages: 14

PMG

XLDnaute Junior
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'

Merci d'avance
PMG
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
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.
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour @PMG :), @sylvanu ;),

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)
 

Pièces jointes

  • PMG- VBA Couleurs et dates- v2.xlsm
    35.5 KB · Affichages: 4
Dernière édition:

PMG

XLDnaute Junior
Rebonjour mapomme et sylvanu,

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!
 

mapomme

XLDnaute Barbatruc
Supporter XLD
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.
 
Dernière édition:

jmfmarques

XLDnaute Accro
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.
 

PMG

XLDnaute Junior
Re mapomme,

Pas de problème pour télécharger, le fichier marche super bien! 0,156 sec

Peux tu stp m'expliquer cette ligne:
VB:
colA = 6 + 4 * (Format(t(i,2), "hh") - 8)
ColA = colA + Int(Format(t(i, 2), "nn") / 15)
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Re @PMG ;),

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:confused:.
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

Voila, voilou...
 
Dernière édition:

PMG

XLDnaute Junior
Bonjour mapomme,

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).

VB:
colA = 6 + 4 * (Format(t(i, 2), "hh") - 9)
ou
Code:
colA = 6 + 4 * (Format(t(i, 2), "hh") - (Format(Cells(13, 6), "hh")))
pour prendre en compte la modification!

Par contre si je mets 10:00h en "F13", c'est la cata car les couleurs sortent du champs du tableau!

2/ Pour cette partie du code:
Code:
      If ligne > UBound(t) Then KO = True
      ligne = ligne + 15      ' la ligne concernée

Peut on l'effacer, car les données sont créés avec une autre macro et non manuellement comme j'ai omis de le mentionner.

Un grand merci!
PMG
 

Discussions similaires

Réponses
0
Affichages
83
Réponses
23
Affichages
1 K

Statistiques des forums

Discussions
311 715
Messages
2 081 822
Membres
101 822
dernier inscrit
holale