Discussion :

[isrdum]

Bonjour

J'ai deux colonne distinctes (D) et (H) dans lesquelles je veux mettre de la couleur en fonction de la présence de texte (si il y a du texte dans C et que je clique dans D, la couleur s'ajoute) (si il y a du texte dans G et que je clique dans H, la couleur s'ajoute)
J'ai écris un code pour permettre de gérer ces deux situation indépendamment, mais ça ne fonctionne pas!!!
Ce n'est que la première partie du programme qui est exécuté (dans ce cas-ci les colonnes G et H), sans considérer l'autre partie

Quelqu'un aurait une idée?
Merci!

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
Dim Lastrow As Integer
Dim Lastrow2 As Integer
Dim rng1 As Range, cell1 As Range
Dim rng2 As Range, cell2 As Range
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 
    Lastrow1 = Feuil1.Cells(Rows.Count, 3).End(xlUp).Row
    Lastrow2 = Feuil1.Cells(Rows.Count, 7).End(xlUp).Row
    Set rng1 = Range("C4:C" & Lastrow1)
    Set rng2 = Range("G4:G" & Lastrow2)
 
    For Each cell2 In rng2
        If Intersect(Target, Range("H4:H" & (Lastrow2))) Is Nothing Then Exit Sub
            Cancel = True
            Select Case Target.Interior.ColorIndex
                Case xlNone, 4: Target.Interior.ColorIndex = 6
                Case xlNone, 6: Target.Interior.ColorIndex = 3
                Case Else: Target.Interior.ColorIndex = 4
            End Select
    Next cell2
 
    For Each cell1 In rng1
        If Intersect(Target, Range("D4:D" & (Lastrow1))) Is Nothing Then Exit Sub
            Cancel = True
            Select Case Target.Interior.ColorIndex
                Case xlNone, 4: Target.Interior.ColorIndex = 6
                Case xlNone, 6: Target.Interior.ColorIndex = 3
                Case Else: Target.Interior.ColorIndex = 4
            End Select
    Next cell1
 
End Sub

[isrdum]

Ma solution

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
Dim Lastrow As Integer
Dim Lastrow2 As Integer
Dim rng1 As Range, cell1 As Range
Dim rng2 As Range, cell2 As Range
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 
    Lastrow1 = Feuil1.Cells(Rows.Count, 3).End(xlUp).Row
    Lastrow2 = Feuil1.Cells(Rows.Count, 7).End(xlUp).Row
    Set rng1 = Range("C4:C" & Lastrow1)
    Set rng2 = Range("G4:G" & Lastrow2)
 
    For Each cell2 In rng2
        If Intersect(Target, Range("H4:H" & (Lastrow2))) Is Nothing Then Goto A
            Cancel = True
            Select Case Target.Interior.ColorIndex
                Case xlNone, 4: Target.Interior.ColorIndex = 6
                Case xlNone, 6: Target.Interior.ColorIndex = 3
                Case Else: Target.Interior.ColorIndex = 4
            End Select
    Next cell2
 
A:
    For Each cell1 In rng1
        If Intersect(Target, Range("D4:D" & (Lastrow1))) Is Nothing Then Exit Sub
            Cancel = True
            Select Case Target.Interior.ColorIndex
                Case xlNone, 4: Target.Interior.ColorIndex = 6
                Case xlNone, 6: Target.Interior.ColorIndex = 3
                Case Else: Target.Interior.ColorIndex = 4
            End Select
    Next cell1
 
End Sub