Solution VBA trop longue

[Nanard]

Bonjour à tout le forum,

Voici mon problème, je bosse actuellement sur prog de plannification des 35 heures.

J'ai écrit une macro beaucoup trop longue, qui fonctionne à merveille...
Y a t'il une solution avec une boucle, sachant que je fais référence à de multiples cellules pour que je puisse renvoyer une couleur sur une autre feuille qui prend une condition de couleur par semaine et pour 52 semaine/ligne
Un bout de mon code pour comprendre

Sub Administratif_CHL()
Dim secteurs As Range
Sheets("Administratifs").Select
Application.ScreenUpdating = False
'Semaine 1
If Sheets("Administratifs").Range("D9") = "N" Then
Sheets("Synthèse secteurs").Range("B3").Interior.ColorIndex = 8
End If
If Sheets("Administratifs").Range("D9") = "HA" Then
Sheets("Synthèse secteurs").Range("B3").Interior.ColorIndex = 36
End If
If Sheets("Administratifs").Range("D9") = "MH" Then
Sheets("Synthèse secteurs").Range("B3").Interior.ColorIndex = 27
End If
If Sheets("Administratifs").Range("D9") = "MB" Then
Sheets("Synthèse secteurs").Range("B3").Interior.ColorIndex = 10
End If
'Semaine 2
If Sheets("Administratifs").Range("D16") = "N" Then
Sheets("Synthèse secteurs").Range("C3").Interior.ColorIndex = 8
End If
If Sheets("Administratifs").Range("D16") = "HA" Then
Sheets("Synthèse secteurs").Range("C3").Interior.ColorIndex = 36
End If
If Sheets("Administratifs").Range("D16") = "MH" Then
Sheets("Synthèse secteurs").Range("C3").Interior.ColorIndex = 27
End If
If Sheets("Administratifs").Range("D16") = "MB" Then
Sheets("Synthèse secteurs").Range("C3").Interior.ColorIndex = 10
End If
'S3
If Sheets("Administratifs").Range("D30") = "N" Then
Sheets("Synthèse secteurs").Range("D3").Interior.ColorIndex = 8
End If
If Sheets("Administratifs").Range("D30") = "HA" Then
Sheets("Synthèse secteurs").Range("D3").Interior.ColorIndex = 36
End If
If Sheets("Administratifs").Range("D30") = "MH" Then
Sheets("Synthèse secteurs").Range("D3").Interior.ColorIndex = 27
End If
If Sheets("Administratifs").Range("D30") = "MB" Then
Sheets("Synthèse secteurs").Range("D3").Interior.ColorIndex = 10
End If
'S4
If Sheets("Administratifs").Range("H7") = "N" Then
Sheets("Synthèse secteurs").Range("E3").Interior.ColorIndex = 8
End If
If Sheets("Administratifs").Range("H7") = "HA" Then
Sheets("Synthèse secteurs").Range("E3").Interior.ColorIndex = 36
End If
If Sheets("Administratifs").Range("H7") = "MH" Then
Sheets("Synthèse secteurs").Range("E3").Interior.ColorIndex = 27
End If
If Sheets("Administratifs").Range("H7") = "MB" Then
Sheets("Synthèse secteurs").Range("E3").Interior.ColorIndex = 10
End If
'S5
If Sheets("Administratifs").Range("H13") = "N" Then
Sheets("Synthèse secteurs").Range("F3").Interior.ColorIndex = 8
End If
If Sheets("Administratifs").Range("H13") = "HA" Then
Sheets("Synthèse secteurs").Range("F3").Interior.ColorIndex = 36
End If
If Sheets("Administratifs").Range("H13") = "MH" Then
Sheets("Synthèse secteurs").Range("F3").Interior.ColorIndex = 27
End If
If Sheets("Administratifs").Range("H13") = "MB" Then
Sheets("Synthèse secteurs").Range("F3").Interior.ColorIndex = 10
End If
'S6
If Sheets("Administratifs").Range("H20") = "N" Then
Sheets("Synthèse secteurs").Range("G3").Interior.ColorIndex = 8
End If
If Sheets("Administratifs").Range("H20") = "HA" Then
Sheets("Synthèse secteurs").Range("G3").Interior.ColorIndex = 36
End If
If Sheets("Administratifs").Range("H20") = "MH" Then
Sheets("Synthèse secteurs").Range("G3").Interior.ColorIndex = 27
End If
If Sheets("Administratifs").Range("H20") = "MB" Then
Sheets("Synthèse secteurs").Range("G3").Interior.ColorIndex = 10
End If
'S7
If Sheets("Administratifs").Range("H27") = "N" Then
Sheets("Synthèse secteurs").Range("H3").Interior.ColorIndex = 8
End If
If Sheets("Administratifs").Range("H27") = "HA" Then
Sheets("Synthèse secteurs").Range("H3").Interior.ColorIndex = 36
End If
If Sheets("Administratifs").Range("H27") = "MH" Then
Sheets("Synthèse secteurs").Range("H3").Interior.ColorIndex = 27
End If
If Sheets("Administratifs").Range("H27") = "MB" Then
Sheets("Synthèse secteurs").Range("H3").Interior.ColorIndex = 10
End If
....etc jusqu'à 52 semaines avec 4 conditions / semaine

Il y à 25 secteurs ce qui veut dire qu'il faut que je fasse 25 fois cette macro avec :
range ("H4").Interior.ColorIndex = 10 'pour un autre secteur (ligne)

avec les "N", "HA", "MH","MB" je fais référence au niveau d'activité
Ne faudait il pas construire une boucle ? mais comment ! je sèche lamentablement, merci à celui ou celle qui voudra bien m'aider
j'espère avoir été assez clair !!
@

Nanard

 

[@+Thierry]

bonjour Nanard, le Forum

J'ai un peu regardé ton code, tout pourrait bien aller pour te construire un algorhytme qui tienne en quelques lignes, mais hélas, car il y a un hélas, c'est cette rupture de logigue entre :

If Sheets("Administratifs").Range("D16") = "MB" Then
Sheets("Synthèse secteurs").Range("C3").Interior.ColorIndex = 10
End If
'S3
If Sheets("Administratifs").Range("D30") = "N" Then
Sheets("Synthèse secteurs").Range("D3").Interior.ColorIndex = 8
End If

Pourquoi ??? Alors qu'on allait de 7 en 7 (Semaine1 = D9... Semaine2 = D16)... donc logiquement la semaine3 aurait dû être "D23" et pas "D30" (qui serait donc pour la semaine4)...

Ensuite on reste bien en base 7 à 7 mais on passe carrément dans une autre colonne (de "D" à "H".....) là c'est pas possible, je ne peux pas boucler en algo correctement si on joue aussi à "saute colonnes" dans le tableau source...

Sinon, pour te donner un apperçu de ce que çà donnerait si tu avais un tableau structuré en ayant tes Critères "N", "HA", "MH", "MB" uniquement en Colonne "D" de la ligne 9 à 366 de sept en sept :


Sub AdmininstratifPossibiliteSructure()
Const Ls As Byte = 3
Dim WSSource As Worksheet, WSCible As Worksheet
Dim Item As Variant
Dim L As Integer
Dim CS As Byte

Set WSSource = Sheets("Administratifs")
Set WSCible = Sheets("Synthèse secteurs")

CS = 2

  For L = 9 To 366 Step 7 '"Soit de la Ligne 9 à la ligne 366, 7 par 7, pour 52 semaines)
     For Each Item In Array("N", "HA", "MH", "MB")
       If Item = WSSource.Cells(L, 4) Then
            Select Case Item
            Case "N": WSCible.Cells(Ls, CS).Interior.ColorIndex = 8
            Case "HA": WSCible.Cells(Ls, CS).Interior.ColorIndex = 36
            Case "MH": WSCible.Cells(Ls, CS).Interior.ColorIndex = 27
            Case "MB": WSCible.Cells(Ls, CS).Interior.ColorIndex = 10
            End Select
       End If
     Next Item
  CS = CS + 1
  Next L

End Sub

Sinon, faire un Algo en enchainement de boucles incrémentées de façon cohérente, relève de l'exploit (ou de l'usine à gaz) sur un tableau désordonné.

Bon courage et bon dimanche à tous et toutes
@+Thierry

 

[@+Thierry]

Tiens, en me relisant, petite optimisation du coeur de cette boucle :

  For L = 9 To 366 Step 7 '"Soit de la Ligne 9 à la ligne 366, 7 par 7, pour 52 semaines)
     For Each Item In Array("N", "HA", "MH", "MB")
       If Item = WSSource.Cells(L, 4) Then
          With WSCible.Cells(Ls, CS).Interior
            Select Case Item
            Case "N": .ColorIndex = 8
            Case "HA": .ColorIndex = 36
            Case "MH": .ColorIndex = 27
            Case "MB": .ColorIndex = 10
          End With
            End Select
       End If
     Next Item
  CS = CS + 1
  Next L

Bon Dimanche
@+Thierry

 

[@+Thierry]

Décidément !, pas réveillé ce dimanche ! lol

  For L = 9 To 366 Step 7 '"Soit de la Ligne 9 à la ligne 366, 7 par 7, pour 52 semaines)
     For Each Item In Array("N", "HA", "MH", "MB")
       If Item = WSSource.Cells(L, 4) Then
          With WSCible.Cells(Ls, CS).Interior
            Select Case Item
&nbsp            Case "N": .ColorIndex = 8
&nbsp            Case "HA": .ColorIndex = 36
&nbsp            Case "MH": .ColorIndex = 27
&nbsp            Case "MB": .ColorIndex = 10
&nbsp            End Select
          End With
       End If
     Next Item
  CS = CS + 1
  Next L

Sorry
@+Thierry

 

[CBernardT]

Bonjour Nanard et Thierry

Une proposition de solution très similaire à celle de Thierry;

Une boucle pour les secteurs ;
Une boucle sur les semaines dont la liste des cellules repères est à compléter.
Un select case pour choisir la couleur du niveau d'activité.

Cordialement

CBernardT

 

[@+Thierry]

Bonjour Bernard, re Nanard

Je viens de regarder ton exemple Bernard. Pour ma part je n'avais pas compris sur plusieurs feuilles... Mais c'est possible !

Oui Bernard, le scan de ranges disparates peut être "The" solution pour Nanard si il persiste de travailler sur un tableau non structuré. (ce que je ne fais jamais)

Sinon dans cette éventualité, pour éviter d'avoir à identifier et saisir en dûr dans VBA les 52 cellules comme ceci :
For Each C In Sheets(i).Range("D9,D16,D30,H7,H13,H20,H27, etc etc etc")

Il peut nommer sa plage "Sector1" (en sélection à la souris de cellules non contigues en maintenant la touche CTRL enfoncée pendant la sélection) et faire ce genre de code :
For Each C In Sheets(i).Range("Sector1").

Ce qui a pour avantage aussi de n'avoir pas à ce soucier du code si on ajoute des Lignes/Colonnes ou on en supprime.

En cas de multi-pages, ce dont je ne suis pas encore certain, il suffit de faire coïncider l'index des feuilles avec le "Sector" name... comme ceci :
For i = 2 To Sheets.Count
For Each C In Sheets(i).Range("Sector" & i)

Bonne fin de journée

 

[Nanard]

Bonsoir à vous deux,

Effectivement @+Thierry j'ai loupé un pas en D23
Je n'arrive pas à adapter la macro àCBernardT

J'ai encore de la peine avec les boucles

Voici un exemple de mon fichier, je n'ai laissé qu'une feuille pour un seul secteur (oxycoupage) pour qu'il soit moins lourd

Merci pour l'aide

Nanard

 

[CBernardT]

Re Nanard et Thierry

Selon le vieil adage énonçant qu’un petit schéma vaut mieux qu'un long discours, si tu avais placé ton exemple en pièce jointe dans le premier post, cela aurait simplifié la compréhension du projet.
Après ce petit conseil pour les appels futurs, je te livre quelques réflexions sur l’essai.

1-Une macro de mise en couleur des niveaux d’activité mis en place le LUNDI, critère choisi pour pallier au changement d’année, avec une particularité de mon cru : la mise en couleur des niveaux d’activité placés à droite des lundis dans les feuilles de secteur qui permet de voir s’il n’y a pas d’erreur de report des niveaux d’activité ;
2- Une macro d’effacement des couleurs du tableau annuel de synthèse ;
3- Une macro pour l’effacement de la couleur placée dans les feuilles de secteur.

Si tu as des problèmes de mise au point, n’hésite pas à faire de nouveau appel.

Cordialement

CBernardT

 

[Nanard]

Nanard,

Je remercie CbernardT et @+Thierry pour leur aide, j'ai utilisé la macro à CbernardT en partant de la 1ère feuil et pas la 2°
For i = 1 To Sheets.Count

et je me suis paluché les 52 cellules

For Each C In Sheets(i).Range("D9,D16,D23,D30,D37,H13,H20,H27,H34,L13,L20,L27,L35,P10,P17,P24,P31,T8,T15,T22,T29,T36,X12,X19,X26,X33,AB10,AB17,AB24,AB31,AF7,AF14,AF22,AF28,AF35,AJ11,AJ18,AJ25,AJ32,AN9,AN16,AN23,AN30,AR9,AR13,AR20,AR27,AR34,AV11,AV18,AV25,AV32")

la boucle est bouclée ! lol

Merci à vous deux

@+
Nanard

 

[Sylvain]

Bonjour,

je sais que c'est après la bataille, mais pour une prochaine fois.
Tu cliques dans chaque cellule avec la touche ctrl appuyée.
Tu fais insertion nom définir "toto"
Comme ça tu peux faire dans ta macro
for each c in range("toto")


Je ne sais pas si ça marche sur plusieurs feuilles, mais ça a l'avantage de rester valable si tu fais une insertion ou une suppression de ligne. Car dans le cas où on ne nomme pas les cellules, un décalage et on doit retravailler sa macro !

A+