Améliorer code VBA pour mise en forme

**majothi** · 27/12/2012, 12h10

Je suis à la recherche d'une solution plus simple afin de ne pas ralentir la saisie ds ma feuille.

Les cellules de la colonne A conditionnent la couleur ds les cellules qui sont sur la même ligne pour colonne B à F.

Merci d'avance pour votre aide

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim i&
    With Feuil14
        For i = 1 To 6000
            'si cellule colonne A # vide et cellules colonnes B a F # vide
            If .Cells(i, 1) <> "" Then
                For j = 1 To 6
                    If .Cells(i, j) <> "" Then
                        Cells(i, j).Interior.ColorIndex = 3
                    End If
                Next j
            End If
            'si cellule colonne A = vide et cellules colonnes B a F # vide
            If .Cells(i, 1) = "" Then
                For j = 1 To 6
                    If Cells(i, j) <> "" Then
                        Cells(i, j).Interior.ColorIndex = 4
                    End If
                Next j
            End If
            'si cellule colonne A = vide et cellules colonnes B a F = vide
            If .Cells(i, 1) = "" Then
                For j = 1 To 6
                    If .Cells(i, j) = "" Then
                        Cells(i, j).Interior.ColorIndex = xlNone
                    End If
                Next j
            End If
            'si cellule colonne A # vide et cellules colonne B à F = vide
            If .Cells(i, 1) <> "" Then
                For j = 1 To 6
                    If .Cells(i, j) = "" Then
                        Cells(i, j).Interior.ColorIndex = xlNone
                    End If
                Next j
            End If
 
        Next i
    End With
End Sub

**Daniel.C** · 27/12/2012, 13h29

Bonjour,

Est-ce que tu peux expliquer ce que tu cherches à faire ?

**majothi** · 27/12/2012, 17h10

Désolé par mon manque de précision.

Je vais essayer d'être plus clair.

Petit exemple:

je possède 6 colonnes A,B,C,D,E,F

lorsque je met "x" ds la cellule "B2", le font devient vert
lorsque je met "x" ds la cellule "C2", le font devient vert
lorsque je met "x" ds la cellule "E2", le font devient vert
1°)si je met "x" ds la cellule "A2, le fond devient rouge ds "A2" + "B2" + "C2" + "E2"
2°)si j'enlève "x" ds la cellule "A2, le fond devient transparent ds "A2" puis vert ds "B2" et"C2" et "E2"

**SfJ5Rpw8** · 27/12/2012, 17h46

Bonsoir,

tu n'utilise pas le bon événement ... utilise plutôt :

II-E. Worksheet_Change

et ne parcours pas toutes les lignes de ta feuille ... agit seulement sur la ligne sur laquelle as lieu le changement de valeur ... et seulement si ce changement as lieu dans les colonnes A à E...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Private Sub Worksheet_Change(ByVal Target As Range)
 if Target.Column < 6
...

**Daniel.C** · 27/12/2012, 17h59

Mets la macro suivante dans le module de la feuille :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column > 6 Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    If Target.Value = "x" Then
        Select Case Target.Column
            Case 1
                Target.Resize(, 3).Interior.ColorIndex = 3
                Cells(Target.Row, 5).Interior.ColorIndex = 3
            Case 2, 3, 5
                Target.Interior.ColorIndex = 4
        End Select
    ElseIf Target.Column = 1 And Target.Value = "" Then
        Target.Interior.ColorIndex = vbnone
    End If
End Sub

**majothi** · 27/12/2012, 18h39

ta proposition m'a beaucoup aidé et se rapproche de ce que je voulais. Voici avec mes modifs

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column > 7 Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    If Target.Value = "x" Then
        Select Case Target.Column
            Case 1
                With Target.Interior
                    .Pattern = xlPatternLinearGradient
                    .Gradient.Degree = 90
                    .Gradient.ColorStops.Clear
                End With
                With Target.Interior.Gradient.ColorStops.Add(0)
                    .ThemeColor = xlThemeColorDark1
                    .TintAndShade = -0.149021881771294
                End With
                With Target.Interior.Gradient.ColorStops.Add(1)
                    .Color = 255
                    .TintAndShade = 0
                End With
            Case 2, 3, 4, 5, 6
                With Target.Interior
                    .Pattern = xlPatternLinearGradient
                    .Gradient.Degree = 90
                    .Gradient.ColorStops.Clear
                End With
                With Target.Interior.Gradient.ColorStops.Add(0)
                    .ThemeColor = xlThemeColorDark1
                    .TintAndShade = -0.149021881771294
                End With
                With Target.Interior.Gradient.ColorStops.Add(1)
                    .Color = 5296274
                    .TintAndShade = 0
                End With
        End Select
    End If
    If Target.Value <> "x" Then
        Select Case Target.Column
            Case 1, 2, 3, 4, 5, 6
                Target.Interior.ColorIndex = vbnone
        End Select
    End If
End Sub

mon petit soucis est:

si j'ai "x" ds la cellule "A2", celle ci devient rouge (ce qui est bon), mais les autres cellules passeront rouge que si il y a "x" dedans.

si j'enlève "x" de la cellule "A2", celle ci devient transparente (ce qui est bon), mais les autres redeviennet verte si il y a "x" dedans

**Daniel.C** · 27/12/2012, 19h56

si j'ai "x" ds la cellule "A2", celle ci devient rouge (ce qui est bon), mais les autres cellules passeront rouge que si il y a "x" dedans.

Tu as mal transposé mon code, d'une part et tu as ajouté les colonnes D et F. Que veux-tu maintenant ?

**majothi** · 27/12/2012, 21h00

je pense que mes explications ne sont pas assez claires.

je possèdes 6 colonnes A,B,C,D,D,F

si je met "x" ds une cellule de la colonne B ou/et C ou/et D ou/et E ou/et F, le font de vient vert

si je met "x" ds une cellule de la colonne A, celle ci devient rouge, ainsi ques les autres cellules des colonnes B,C,D,E,F si elles contiennent "x", sinon elles restent transparentes

si j'enleve "x" de la cellule ds la colonne A, celle ci devient transparente, et les autres cellules des colonnes redeviennet vertes si elles contiennent "x", sinon elles restent transparentes

**Daniel.C** · 27/12/2012, 21h13

si je met "x" ds une cellule de la colonne B ou/et C ou/et D ou/et E ou/et F, le font de vient vert

et s'il y a déjà un "x" en colonne A ?

Essaie :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column > 6 Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    If Target.Value = "x" Then
        Select Case Target.Column
            Case 1
                For i = 1 To 6
                    If Cells(Target.Row, i) = "x" Then
                        Cells(Target.Row, i).Interior.ColorIndex = 3
                    Else
                        Cells(Target.Row, i).Interior.ColorIndex = vbnone
                    End If
                Next i
            Case 2 To 6
                Target.Interior.ColorIndex = 4
        End Select
    ElseIf Target.Column = 1 And Target.Value = "" Then
        For i = 1 To 6
            If Cells(Target.Row, i) = "x" Then
                Cells(Target.Row, i).Interior.ColorIndex = 4
            Else
                Cells(Target.Row, i).Interior.ColorIndex = vbnone
            End If
        Next i
    End If
End Sub

**majothi** · 28/12/2012, 08h20

et s'il y a déjà un "x" en colonne A ?

Alors les cellules des colonnes B,C,D,E,F passent en rouge dès que je mets "x" dedans

Voici ton code que j'ai modifié pour avoir mon résultat:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Private Sub Worksheet_Change(ByVal Target As Range)
 
    If Target.Column > 6 Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    If Target.Value = "x" Then
        Select Case Target.Column
            Case 1
                For i = 1 To 6
                    If Cells(Target.Row, i) = "x" Then
                        Cells(Target.Row, i).Interior.ColorIndex = 3
                    Else
                        Cells(Target.Row, i).Interior.ColorIndex = vbnone
                    End If
                Next i
            Case 2 To 6
                If Cells(Target.Row, 1) = "x" Then
                        Target.Interior.ColorIndex = 3
                    Else
                        Target.Interior.ColorIndex = 4
                End If
        End Select
    ElseIf Target.Column = 1 And Target.Value = "" Then
        For i = 1 To 6
            If Cells(Target.Row, i) = "x" Then
                Cells(Target.Row, i).Interior.ColorIndex = 4
            Else
                Cells(Target.Row, i).Interior.ColorIndex = vbnone
            End If
        Next i
    End If
    If Target.Value = "" Then
        Select Case Target.Column
            Case 1 To 6
                Target.Interior.ColorIndex = vbnone
        End Select
    End If
End Sub

Daniel.C, je te remercie pour ton aide précieuse et désolé par mon manque de précision.

SUJET CLOS

Améliorer code VBA pour mise en forme

Macros et VBA Excel

Discussions similaires

Partager

Partager