XL 2019 CheckBox pour supprimer une plage de cellules

[Yann71]

Bonjour la com.
J'ai un tableau de plusieurs lignes et colonnes. Devant chaque ligne j'ai inséré des CheckBox. J'aimerai si je coche l'une d'entre-elles et que je valide par un bouton cela efface les données de la ligne. Chaque cellule possède une MFC.
Merci d'avance pour votre aide

 

[sylvanu]

Bonjour Yann,
Perso je préfère aux Checkbox une macro événementielle qui coche une cellule quand on la sélectionne. C'est moins lourd à gérer.
En PJ un exemple.
On sélectionne les lignes à effacer par appui sur la cellule correspondante en colonne A
Un appui sur le bouton EFFACE efface toutes les lignes où il y a un "X"

 

[Yann71]

Bonsoir sylvanu, je te remercie pour ton intervention. Je ne connaissais pas ce principe là. J'avoue que c'est une bonne idée. En testant ton fichier, je me suis aperçu que cela supprime l'entier de la ligne. Dans mon cas je souhaite vider par exemple de A2:A10 uniquement. En continuant mon test j'ai remarqué que si tu vides par exemple uniquement la ligne 10 et que tu souhaite par la suite de vider d'autres lignes, les seule que tu puisse vider sont les lignes de 1 à 9 mais les autre à partir de 11 jusque à l'infini tu ne peut plus les vider, est-ce qu'il y aurait une solution à cela.

 

[sylvanu]

Bonsoir Yann,
Il y avait un piège ... je suis tombé dedans.
J'utilisais tablo = Range("A1).Currentregion
Le tablo s’arrête donc à la première ligne vide. Donc après un premier effacement, le tablo s'arrête à la première ligne qui a été éffacée.
En PJ une nouvelle version, j'analyse les 5000 premières lignes, sans m'attarder si vide ou non.
C'est un peu plus long, mais ça marche.
Sorry.

 

[Yann71]

Bonjour sylvanu, ne soit pas dsl c'est humain que de se tromper. Je te remercie car tu sus trouver la solution à ma demande. Juste une question au passage est-ce qu'il est possible d'incérer cette fonction dans un User, par pur hasard

 

[sylvanu]

Bonjour,
La fonction Worksheet_SelectionChange doit rester dans la feuille. De toute façon son action est indépendante d'un userform.
La fonction Efface peut évidemment être intégré dans un Userform. Cependant il faut préciser la feuille sur lequel elle s'applique et améliorer la recherche de la dernière ligne pour être plus rapide.

Sub Efface()
DerLig = Sheets("Feuil1").Range("A65500").End(xlUp).Row
tablo = Sheets("Feuil1").Range("A1:A" & DerLig)
For i = 1 To UBound(tablo)
    If tablo(i, 1) = "X" Then
        Sheets("Feuil1").Rows(i).ClearContents
    End If
Next i
End Sub

Donc dans l'userform, sur le bouton qui va bien, il suffit de faire un Call Efface.

 

[Yann71]

Je pense que je vais rester sur ta première solution. Merci encore et bonne journée malgré ce COVID.

 

[sylvanu]

Remplacez quand même Efface par cette nouvelle macro.
Le calcul de la dernière ligne permet d'être plus rapide et ne posera pas de problème si votre nombre de lignes dépassait 5000.

 

[Yann71]

D'accord, je vais y apporter cette modif, merci encore

 

[Yann71]

Je me permet de revenir, j'ai comme un petit problème, lorsque je clic sur le bouton effacer, cela me vide la ligne entière alors que j'aimerai que cela vide une partie de A3:G3

 

[sylvanu]

Bonjour,
La PJ modifiée :

Sub Efface()
DerLig = Sheets("Feuil1").Range("A65500").End(xlUp).Row
tablo = Sheets("Feuil1").Range("A1:A" & DerLig)
For i = 1 To UBound(tablo)
    If tablo(i, 1) = "X" Then
        Sheets("Feuil1").Range(Cells(i, 1), Cells(i, 7)).ClearContents
    End If
Next i
End Sub

 

[Yann71]

Merci beaucoup. J'ai encore une question, j'ai fais une modification sur ton fichier. J'ai fait en sorte que les croix s'affiche dans la colonne N et non dans la A. Mais lorsque je valide avec le bouton "EFFACE" la croix reste toujours visible alors que dans le ton fichier dans la colonne A les croix s'efface. Dsl si je me montre difficile.

 

[sylvanu]

j'aimerai que cela vide une partie de A3:G3

et bizarrement la colonne N n'est pas éffacée !!!

Il faut reprendre les deux macros :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("N2:N1000")) Is Nothing Then
    Application.EnableEvents = False
    If Target = "X" Then
        Target = ""
    Else
        Target = "X"
    End If
    Application.EnableEvents = True
End If
End Sub
Sub Efface()
DerLig = Sheets("Feuil1").Range("N65500").End(xlUp).Row
tablo = Sheets("Feuil1").Range("N1:N" & DerLig)
For i = 1 To UBound(tablo)
    If tablo(i, 1) = "X" Then
        Sheets("Feuil1").Range(Cells(i, 1), Cells(i, 7)).ClearContents
        Sheets("Feuil1").Range("N" & i) = ""
    End If
Next i
End Sub

 

[Yann71]

Merci beaucoup, j'apprécie ton aide. J'aimerai pouvoir comprendre ton code sachant que je suis un novice très peu avancé.

 

[sylvanu]

With comments.
Have a good night.