correction de macro Sub colorise()

[olibelle0101]

Bonsoir le forum.
Je me trouve avec un petit soucis de code.
Voici ce code :
Sub colorise()
Worksheets("selections").Activate
For ligne = 3 To 369
Set r1 = Range(Cells(ligne, 9), Cells(ligne, 19))
r1.Select
For Each c In r1
If c.Value = Cells(ligne, 21).Value Then
c.Font.Bold = True
With c.Interior
.ColorIndex = 34
.Pattern = xlSolid
End With
End If
Next c
For Each c In r1
If c.Value = Cells(ligne, 22).Value Then
c.Font.Bold = True
With c.Interior
.ColorIndex = 40
.Pattern = xlSolid
End With
End If
Next c
For Each c In r1
If c.Value = Cells(ligne, 23).Value Then
c.Font.Bold = True
With c.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
End If
Next c
For Each c In r1
If c.Value = Cells(ligne, 24).Value Then
c.Font.Italic = True
c.Font.Bold = True
With c.Interior
.ColorIndex = 35
.Pattern = xlSolid
End With
End If
Next c
For Each c In r1
If c.Value = Cells(ligne, 25).Value Then
c.Font.Italic = True
With c.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With
End If
Next c
Next ligne
End Sub
Il me met une couleur suivant des valeur identique (c'est parfait)
Mais si il y a aucune valeur dans "ligne 21 22 ou 23 etc..."
Je ne veut pas qu'il me met de couleur dans "Set r1 = Range(Cells(ligne, 9), Cells(ligne, 19))"
si dans celle-ci il y a aussi aucune valeur dans certaines cellules.
Merci pour vos conseil.
A bientôt.

 

[jpb388]

Re : correction de macro Sub colorise()

bonsoir à tous

à tester

Sub colorise()
Dim Reponse As Range, Lg&, Lg1&, Pos%, Pos1%, Pos2%, Depart&, Fin&
 Worksheets("selections").Activate
On Error GoTo Err
 Set Reponse = Application.InputBox(prompt:="Sélectionner la ou les ligne(s) que vous voulez traitée(s)", _
    Title:="Formatage ligne(s)", Default:="$3:$369", Type:=8)
If Reponse.Address = "" Then Exit Sub
On Error GoTo 0
Pos = InStr(Reponse.Address, "$")
Pos1 = InStr(1, Reponse.Address, ":")
Pos2 = InStr(Pos + 1, Reponse.Address, "$")
If Pos2 < Pos1 Then GoTo Err
Depart = Mid(Reponse.Address, Pos + 1, Pos1 - (Pos + 1))
Fin = Right(Reponse.Address, Len(Reponse.Address) - Pos2)
 For ligne = Depart To Fin
    Set r1 = Range(Cells(ligne, 9), Cells(ligne, 19))
    r1.Select
    For Each c In r1
        If c.Value = Cells(ligne, 21).Value Then
            c.Font.Bold = True
            With c.Interior
               .ColorIndex = 34
               .Pattern = xlSolid
            End With
        End If
    Next c
    For Each c In r1
        If c.Value = Cells(ligne, 22).Value Then
            c.Font.Bold = True
            With c.Interior
                .ColorIndex = 40
                .Pattern = xlSolid
            End With
        End If
    Next c
    For Each c In r1
        If c.Value = Cells(ligne, 23).Value Then
            c.Font.Bold = True
            With c.Interior
            .ColorIndex = 36
            .Pattern = xlSolid
            End With
        End If
    Next c
    For Each c In r1
        If c.Value = Cells(ligne, 24).Value Then
            c.Font.Italic = True
            c.Font.Bold = True
            With c.Interior
                .ColorIndex = 35
                .Pattern = xlSolid
            End With
        End If
    Next c
    For Each c In r1
        If c.Value = Cells(ligne, 25).Value Then
            c.Font.Italic = True
            With c.Interior
                .ColorIndex = 15
                .Pattern = xlSolid
            End With
        End If
    Next c
 Next ligne
 Exit Sub
Err:
If Not Reponse Is Nothing Then
    MsgBox "Votre entrée n'est pas une plage valide." & vbCrLf & "Vous devez sélectionner des lignes.", vbCritical
End If
 End Sub

bonne nuit
a+

 

[olibelle0101]

Re : correction de macro Sub colorise()

Merci beaucoup,
c'est au réveil que j'ai trouvé votre réponse.
C'est génial.
Bonne journée.