Microsoft 365 Peut on simplifier ce code ? (Résolu)

[Kael_88]

Le forum,

Si cela était possible, je voudrai savoir s'il est possible de simplifier le code suivant et par quoi.
pour résumer, dans un tableau, on colorie les cellules une ligne sur deux en partant des cellules ligne 2
pour les colonnes :
C à F en vert,
G à I en rose pale,
J à K en vert pale,
L à N en bleu pale,
O à P en orange pale,

cordialement

' Reference centrée
    Rows("3").Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

' Couleur colonne
    Range("C4:F4").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5296274
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("G4:I4").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    Range("J4:K4").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    Range("L4:N4").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent5
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    Range("O4:P4").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent4
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    Range("Q4:R4").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    Rows("3:4").Select
    Selection.Copy
    Range(Selection, Selection.End(xlDown)).Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("A2").Select
    Application.CutCopyMode = False

 

[Staple1600]

Bonsoir le fil, Kael_88

Pour les couleurs, ma façon de faire

Sub Couleurs()
Dim i, Gribouillage
Range("C4:F4").Interior.Color = 5296274
Gribouillage = Array(Array("G4:I4", 6), Array("J4:K4", 10), Array("L4:N4", 9), Array("O4:P4", 8), Array("Q4:R4", 7))
For i = 0 To 4
With Range(Gribouillage(i)(0)).Interior
.ThemeColor = Gribouillage(i)(1): .TintAndShade = 0.799981688894314
End With
Next
End Sub

PS: Code rédigé et testé avant les ajouts du demandeur dans l'édition du message#1

 

[Staple1600]

Re

Une variante "simplifiée" du code précédent, en espérant que j'ai compris la question. 😉

Sub Couleurs_III()
Dim i, j&, Gribouillage
Gribouillage = Array(Array("G$:I$", 6), Array("J$:K$", 10), Array("L$:N$", 9), Array("O$:P$", 8), Array("Q$:R$", 7))
For i = 3 To 100
If i Mod 2 = 0 Then
Cells(i, 3).Resize(, 4).Interior.Color = 5296274
For j = 0 To 4
With Range(Replace(Gribouillage(j)(0), "$", i)).Interior
.ThemeColor = Gribouillage(j)(1): .TintAndShade = 0.799981688894314
End With
Next j
End If
Next i
End Sub

 

[sylvanu]

Bonsoir Kael, ReBonsoir Staple
Déjà une simplication, on peut remplacer ça :

Range("C4:F4").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5296274
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

par ça :

Range("C4:F4").Interior.Color = RGB(146, 208, 80)

ou encore par :

Range("C4:F4").Interior.ColorIndex = 43

si on a choisi dans la table des couleurs. Malheureusement ici, seules 4 sur 6 en sont issues.
Bonsoir tout le monde.

 

[Staple1600]

ReBonsoir sylvanu

=>sylvanu
Pas d'idée pour simplifier la simplification de ma simplification ? 😉

 

[Kael_88]

Le forum, @Staple1600 , @sylvanu ,

je vous remercie de votre réactivité, vous m'avez fourni ce que je demandai,
c'est la deuxième proposition de @Staple1600 , qui s'adapte le mieux à mon besoin.

Merci encore à vous.

cordialement

 

[sylvanu]

Bien le bonjour Kael, Staple,
Staple, 14 lignes se simplifient toujours. Ici en 6 lignes :

Sub Couleurs_IV()
C = Array(3, 6, 18, 26, 10, 7, 9, 30, 27, 27, 10, 11, 31, 29, 27, 12, 14, 27, 29, 30, 15, 16, 28, 28, 29, 17, 18, 29, 30, 27)
For i = 0 To 29 Step 5
    Range(Cells(3, C(i)), Cells(3, C(i + 1))).Interior.Color = RGB(8 * C(i + 2), 8 * C(i + 3), 8 * C(i + 4))
Next i
End Sub

Mes respects du matin.

 

[sylvanu]

Re Staple,
Bien évidemment, je pourrais vous proposer ça en 4 lignes:

Sub Couleurs_V()
Range("C4:F4").Interior.Color = RGB(146, 208, 80): Range("G4:I4").Interior.Color = RGB(242, 221, 220): Range("J4:K4").Interior.Color = RGB(253, 233, 217)
Range("L4:N4").Interior.Color = RGB(219, 238, 243): Range("O4:P4").Interior.Color = RGB(229, 224, 236): Range("Q4:R4").Interior.Color = RGB(234, 241, 221)
End Sub

mais vous allez me taxer de mauvaise foi. 😉

 

[Staple1600]

Bonsoir le fil

sylvanu
Dans Couleurs_V, il manque cet aspect de la question non ?

pour résumer, dans un tableau, on colorie les cellules une ligne sur deux en partant des cellules ligne 2

Compléter par ce qu'on peut supputer de

Rows("3:4").Select
    Selection.Copy
    Range(Selection, Selection.End(xlDown)).Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

Pour faire dans la tranche de foi (qui désormais n'est plus uptodate 😉)
Pourquoi ne pas ratiboiser plus court ? 😉
[C4:F4].Interior.Color = RGB(146, 208, 80):[G4:I4].Interior.Color = RGB(242, 221, 220) etc...