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

tiitii60

XLDnaute Nouveau
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
 
Dernière édition:

tiitii60

XLDnaute Nouveau
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

XLDnaute Barbatruc
Supporter XLD
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 :
VB:
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
 

Discussions similaires

Statistiques des forums

Discussions
303 820
Messages
2 014 415
Membres
219 921
dernier inscrit
pascal77500