XL 2019 VBA: Effacer le contenu de plages de cellules avec critères

[tiitii60]

Bonjour,

Je recherche une aide concernant la possibilité d'effacer les contenu de plusieurs cellules en fonction d'un critère.
J'ai un tableau calendrier avec pour chaque mois une colonne dont est renseigné les RTT, CP, ...
Par exemple dans les colonnes E5 a E35, et K5 a K33 et Q5 a Q35 je souhaite supprimer les "RTT" si je clique sur un bouton "effacer RTT" sans effacer les "CP"

J'ai fais une recherche mais je ne parviens pas a trouver une solution a mon problème. j'ai trouvé ce code et j'ai essayé de l'adapter mais cela ne fonctionne pas

Merci pour votre aide.


Sub Efface_CP()

Dim cc As Byte 'déclare la variable cc (Colonne Concours)
Dim dl As Integer 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim cel As Range 'déclare la variable cel (CELlule)

With Sheets("Calendrier") 'prend en compte l'onglet "Calendrier"
For cc = 5 To 78 Step 6 'boucle 1 : sur les colonnes 5 à 78 par pas de 6
dl = .Cells(Application.Rows.Count, cc).End(xlUp).Row 'définit la dernière ligne éditiée dl de la colonne cc
Set pl = .Range(.Cells(1, cc), .Cells(dl, cc)) 'définit la plage pl
For Each cel In pl 'boucle 2 : sur toutes les cellules cel de la plage pl
'si la valeur de la cellule est égale à "CP", efface le contenu de la plage correspondante
If cel.Value = "CP" Then
'cel.Offset(0, -3).Resize(1, 3).Interior.ColorIndex = 3
cel.Offset(1, 1).Resize(1, 1).ClearContents
End If
Next cel 'prochaine cellule de la boucle 2
Next cc 'prochaine colonne de la boucle 1
End With 'fin de la prise en compte de l'onglet "Feuil1"

End Sub

 

[sylvanu]

Bonjour Tiitii,
Essayez :

Sub EffacerRTT()
    dil L%, C%
    For L = 5 To 35
        For C = 5 To 17 Step 6
            If Cells(L, C) = "RTT" Then Cells(L, C) = ""
        Next C
    Next L
End Sub

 

[sylvanu]

Re,
Ou encore, plus rapide :

Sub EffacerRTT()
    Union([E5:E35], [K5:K35], [Q5:Q35]).Replace What:="RTT", Replacement:=""
End Sub

 

[tiitii60]

Bonjour sylvanu,

Merci pour ces deux solutions, la première, fonctionne mais il faut valider pour chaque cas, il faudrait un compteur d'incrémentation jusqu'aux dernières cellules, la deuxième et plus simple mais je n'avais pas donné toutes les données du problème, car dans les colonnes j'ai trois types d'informations, "RTT", "CP" et "CPN1", quand je supprime les CP les cellules avec la donnée CP est bien supprimée, mais celles avec CPN1 le code supprime CP et laisse N1.

 

[sylvanu]

Bonsoir,

mais il faut valider pour chaque cas

Pouvez vous préciser, je ne comprends pas. Cette macro efface tous les RTT de la plage, non ?

quand je supprime les CP les cellules avec la donnée CP est bien supprimée, mais celles avec CPN1 le code supprime CP et laisse N1.

C'est ballot ! Utilisez cette astuce :

Sub EffacerCP()
    Union([E5:E35], [K5:K35], [Q5:Q35]).Replace What:="CP", Replacement:=""
    Union([E5:E35], [K5:K35], [Q5:Q35]).Replace What:="N1", Replacement:="CPN1"
End Sub

 

[tiitii60]

Bonjour,

Concernant la première solution c'est OK cela fonctionne, j'ai été trop vite dans l'analyse.

Merci pour votre aide.