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

[PMG]

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

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

 

[mapomme]

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:

         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 :

      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

 

[PMG]

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 Matin	09:00
Fin Matin	13:00
Début Après midi	14:00
Fin Après midi	18:00

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

 

[mapomme]

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]

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.

 

[PMG]

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:

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:

 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+