Non exécution d'une macro

Bonjour à tous,

J'utilise le code ci-dessous pour affecter des valeurs à plusieurs cellules d'une même collone, mais le code ne fait rien.

Il s'éxécute sans donner d'érreur mais ne s'applique pas !!

Je voudrais SVP comprendre ce qui cloche dedans

Voilà le code :

Sub Niveau()

Dim DerLig As Long, X As Long

With Worksheets("Feuil1")

Application.ScreenUpdating = False

DerLig = .Range("A" & Rows.Count).End(xlUp).Row

For X = DerLig To 3 Step -1

If .Range("A" & X).Interior.ColorIndex = 3 Then

Cells(X, 3) = 0

If .Range("A" & X).Interior.ColorIndex = 6 Then

Cells(X, 3) = 1

If .Range("A" & X).Interior.ColorIndex = 43 Then

Cells(X, 3) = 2

If .Range("A" & X).Value <> o And _

.Range("A" & X).Interior.ColorIndex <> 6 And _

.Range("A" & X).Interior.ColorIndex <> 43 And _

.Range("A" & X).Interior.ColorIndex <> 3 Then

Cells(X, 3) = 3

If .Range("A" & X).Value = 0 Then

Cells(X, 3) = 4

End If

End If

End If

End If

End If

Next X

End With

End Sub

Bonjour,

En indentant ton code, tu vois mieux sa structure.

En particulier, tu t’aperçois que si la cellule n’est pas rouge, tu ne testes pas les autres couleurs et tu passes à la cellule suivante.

Sub Niveau()
Dim DerLig As Long, X As Long
    With Worksheets("Feuil1")
        Application.ScreenUpdating = False
        DerLig = .Range("A" & Rows.Count).End(xlUp).Row
        For X = DerLig To 3 Step -1
            If .Range("A" & X).Interior.ColorIndex = 3 Then
                Cells(X, 3) = 0
                If .Range("A" & X).Interior.ColorIndex = 6 Then
                    Cells(X, 3) = 1
                    If .Range("A" & X).Interior.ColorIndex = 43 Then
                        Cells(X, 3) = 2
                        If .Range("A" & X).Value <> o And _
                        .Range("A" & X).Interior.ColorIndex <> 6 And _
                        .Range("A" & X).Interior.ColorIndex <> 43 And _
                        .Range("A" & X).Interior.ColorIndex <> 3 Then
                            Cells(X, 3) = 3
                            If .Range("A" & X).Value = 0 Then
                                Cells(X, 3) = 4
                            End If
                        End If
                    End If
                End If
            End If
        Next X
    End With
End Sub

Tu peux essayer avec ce code

Sub Niveau()
Dim DerLig As Long, X As Long
    With Worksheets("Feuil1")
        Application.ScreenUpdating = False
        DerLig = .Range("A" & Rows.Count).End(xlUp).Row
        For X = DerLig To 3 Step -1
            Select Case .Range("A" & X).Interior.ColorIndex
                Case 3: Cells(X, 3) = 0
                Case 6: Cells(X, 3) = 1
                Case 43: Cells(X, 3) = 2
                Case -4142: Cells(X, 3) = 4
                Case Else: Cells(X, 3) = 3
            End Select
        Next X
    End With
End Sub

A+

ça marche !!! vraiment mille Merci à toi