Résolu 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
 
Ce fil a été résolu! Aller à la solution…

Fichiers joints

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.
 
Ce message a été identifié comme étant une solution!

Fichiers joints

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.
 

PMG

XLDnaute Junior
Encore merci pour ces explications et votre solution Sylvanu!
Je vais reprendre mon code.
Bonne journée!
 

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)
 
Ce message a été identifié comme étant une solution!

Fichiers joints

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
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour @PMG :)

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).
j'ai ajouté une constante HeurDeb que vous initialiserez à l'heure de début du planning.
Et ajouté une ligne pour initialiser la cellule F13 avec l'heure de début HeurDeb.

Les calculs de ColA et ColB ont été modifiés pour tenir compte de l'heure de début et des limites du planning entre les colonnes F et BE:
VB:
         colA = 6 + 4 * (Format(t(i, 2), "hh") - HeurDeb)
         colA = colA + Int(Format(t(i, 2), "nn") / 15)      ' la colonne de début
         If colA < Cells(1, "f").Column Then colA = Cells(1, "f").Column   ' on limite colA à la colonne F (min)
     
         colB = 6 + 4 * (Format(t(i, 3), "hh") - HeurDeb)
         colB = colB + Int(Format(t(i, 3), "nn") / 15) - 1     ' la colonne de fin
         If colB > Cells(1, "be").Column Then colB = Cells(1, "be").Column   ' on limite colB à la colonne BE (max)



2/ Pour cette partie du 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.
Je ne comprends pas trop la question ?
En tout cas, j'ai supprimé la ligne comprenant KO pour placer le bloc suivant entre un If ... then ... Endif, ce qui donne :
VB:
      If ligne <= UBound(tDates) Then
         ' la date de la tâche a bien été trouvée
         ligne = ligne + 15      ' la ligne concernée
           
         colA = 6 + 4 * (Format(t(i, 2), "hh") - HeurDeb)
         colA = colA + Int(Format(t(i, 2), "nn") / 15)      ' la colonne de début
         If colA < Cells(1, "f").Column Then colA = Cells(1, "f").Column   ' on limite colA à la colonne F (min)
     
         colB = 6 + 4 * (Format(t(i, 3), "hh") - HeurDeb)
         colB = colB + Int(Format(t(i, 3), "nn") / 15) - 1     ' la colonne de fin
         If colB > Cells(1, "be").Column Then colB = Cells(1, "be").Column   ' on limite colB à la colonne BE (max)
       
         If colA <= colB Then
            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
         End If
      End If
Concernant la MFC de la zonedu planning D16:BG46 :
  • j'ai supprimé toute les MFC
  • j'ai formaté la zone en "dur"
  • j'ai défini une seule règle de MFC sur la zone enlevant les bordures entre deux semaines
 

Fichiers joints

Dernière édition:

PMG

XLDnaute Junior
Re @mapomme,

Merci beaucoup pour les modifications apportées au code!
J'ai eu quelques soucis de débordement avec la version précédente!

Très pratique la constante "HeurDeb" cela permettra d'ajuster plus précisément la plage d'heures et merci d'avoir limiter la zone à celle du tableau.

Autre petit problème si une tâche s'étale sur 2 jours, le code ne la prends pas en compte.
J’espère ne pas soulever un problème trop lourds à gérer.
(Aparté / Je ne veux vraiment pas abuser de votre temps et suis déjà comblé avec la macro modifiée, je ne pensais pas que ma discussion puisse aller aussi loin! )

Est il possible d'intégrer ces paramètres (si trop compliqué tant pis):

J'ai une feuille de calcul dédié au calculs de début et fin de tâches que @CISCO ma aidé à formuler.
Donc parfois certaines tâches s'étalent sur plusieurs jours.
Une MFC viendra "remplir" ou "effacer" les cases pour les tâches qui chevauchent les weeks-ends.

Exemple:
Tâche 1
Code 1
Début 18/05/20 16:00
Fin 19/05/20 16:00

Début Matin09:00
Fin Matin13:00
Début Après midi14:00
Fin Après midi18:00

Le résultat est bluffant concernant la rapidité, je n'en reviens tjs pas!
Mille merci mapomme!
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Re,

QUOTE="PMG, post: 20335596, member: 277418"]
Est il possible d'intégrer ces paramètres (si trop compliqué tant pis):
[/QUOTE]

D'emblée, ce n'est pas évident. Le raisonnement est entièrement à revoir.
Je ne comprends plus très bien comment fonctionne le tableau de des tâches. Il faudrait un exemple concret.
Pour ne pas reprendre à partir de zéro, je verrai plus une macro intermédiaire décomposant chaque tâche en tâches élémentaires.
Tâche 1 décomposée en tâche 1.1 du matin du jour J, puis une autre ligne avec une tâche 1.2 pour l'après-midi du jour J, puis une tâche 1.3 pour le matin du jour J+1, etc. (j'ai compris qu'il y avait une pause méridienne, non ?)
Bref un fichier représentatif de votre cas serait utile.
 

PMG

XLDnaute Junior
Re,

Merci pour votre réponse.
Effectivement j'ai deux tableaux à remplir.

1/Tableau 1 (temps réel)
Le code de votre dernier fichier est parfait, il correspond exactement à ma demande.
1.1 Les cases sont remplis par mes soins.
1.2 En actualisant, une macro génèrent la couleur, le début et la fin de chaque tâches pour chaque jour vers un tableau filtré. (copie de couleurs vers dates 03_01.xlsm cf:tableau du haut)
1.3 Votre macro me permet d'afficher les tâches enregistrer comme un historique.

2/Tableau 2 (temps théorique) VBA Couleurs et dates MFC .xlsm
C'est exactement le même forme tableau que le n°1. Ce tableau sert à comparer les temps théoriques et réels.
2.1 Les couleurs, début et fin de tâches sont calculées automatiquement.
2.2 Les cases sont remplis par des MFC (sommeprod qui fait ramer la feuille actuellement, car les 2 tableaux sont sur la même feuille et sont "dynamiques" par le biais de boutons (exemple: copie de couleurs vers dates 03_01.xlsm cf:tableau du bas)
2.3 Je cherche une macro qui intègre les paramètres de couleur, début, fin de journée afin de remplir ce tableau.
 

Fichiers joints

PMG

XLDnaute Junior
Bonjour, le forum, @mapomme, @sylvanu,

Pour répondre aux contrainte du "Tableau2", correspondant à une succesion de MFC avec sommeprod que j’avais jusqu’à présent, je me suis permis de rajouter plusieurs lignes au fichier de @sylvanu.

MFC:
Code:
SOMMEPROD((Code=45)*($D16+F$11>=Début)*($D16+F$11<Fin)*(F$11>=$BI$4)*(F$11<$BL$4)*(JOURSEM($D16;2)<6))>0
VBA:
VB:
 If Weekday(tablo2(i, 4), vbMonday) < 6 Then     'Boucle des jours inférieur à samedi'
    If tablo2(i, 4) + tablo2(11, j) >= tablo(k, 2) Then     'Date de début'
       If tablo2(i, 4) + tablo2(11, j) < tablo(k, 3) Then     'Date de fin'
          If tablo2(11, j) >= Range("BI6").Value Then     'Heure de début'
             If tablo2(11, j) < Range("BL6").Value Then     'Heure de fin'
Je ne sais pas si c'est très conventionnel de mettre autant de If à la suite, mais ça marche apparemment!
PMG
A+
 

Fichiers joints

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas