Effacer le contenu d'une cellule en fonction de sa couleur

Bonjour,

Je cherche á effacer le contenu de cellules contenant une virgule dans un très grand tableau de données. J'ai utilisé le code suivant pour colorier ces cellules en rouge:

Sub MFC()
    With ActiveSheet.Range("A1:CO1193").FormatConditions
        .Delete
        With .Add(xlTextString, TextOperator:=xlContains, String:=",")
            .Interior.Color = RGB(255, 0, 0)
        End With
    End With
End Sub

Ce qui fonctionne bien! Puis, j'ai essayé d'effacer le contenu de ces cellules avec ce code:

Sub Clearcontent()

Dim cell As Range
For Each cell In Range("A1:CO1193")
If cell.Interior.Color = RGB(255, 0, 0) Then
    cell.ClearContents
Else
End If
Next

End Sub

Rien ne se passe. Quelles est l'erreur et comment puis-je la corriger ?

21ortho-data.zip (1.27 Mo)

Ci-dessus le tableau de données concerné.

Une belle soirée,

Vinciane

Bonsoir, essayez comme ça

Sub Clearcontent()

Dim cell As Range
For Each cell In Range("A1:CO1193")
If cell.Interior.Color = RGB(255, 0, 0) Then cell.ClearContents
Next

End Sub

Bonsoir,

Merci pour votre réponse rapide !

Je viens d'essayer à l'instant. Malheureusement, cela ne fonctionne pas.

Supprimer vos 2 macros et mettez celle ci à la place,

Sub test()
Dim Cel As Range
Application.ScreenUpdating = False

  With ActiveSheet.Range("A1:CO1193")

    Set Cel = .Cells.Find(what:=",")
    If Not Cel Is Nothing Then
      Do
        Cel.ClearContents
        Set Cel = .Cells.FindNext(Cel)
      Loop While Not Cel Is Nothing
    End If
  End With

Application.ScreenUpdating = True

End Sub

Bonsoir à vous,

Une autre proposition à tester non en fonction de la couleur mais la virgule directement, une tentative :

Sub MFC()

    Application.ScreenUpdating = False

    Dim Lig As Long, Col As Long, tableau As Variant, i As Long

    i = Cells(Rows.Count, 1).End(xlUp).Row

    tableau = Range("A1:CO" & i) ' Range("A1:CO1193")

    For Lig = LBound(tableau, 1) To UBound(tableau, 1)
        For Col = LBound(tableau, 2) To UBound(tableau, 2)
            If InStr(tableau(Lig, Col), ",") Then
                tableau(Lig, Col) = Empty
            End If
        Next Col
    Next Lig

    ' Range("A1:CO1193")
    Range("A1:CO" & i) = tableau

    Application.ScreenUpdating = True

End Sub

Bonjour Nico et Shenzar,

Une immense merci pour vos solutions ! Les deux fonctionnent parfaitements !

Une très belle journée à vous,

Vinciane

Rechercher des sujets similaires à "effacer contenu fonction couleur"