Suppression de ligne en VBA

Version imprimable

Voir 40 message(s) de cette discussion en une page

Bonjour Je voudrai que lorsque que je clique sur le bouton supprimer qu'il me demande le numéro d 'identifiant que je souhaite supprimer et de me supprimer la ligne si je fais oui si non il fait rien et ferme la fenêtre.

Je galère un peut voici mon code merci beaucoup
Je fais cela pour une association.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 Private Sub btnsupdelabasebddinv_Click() Sheets("DOSSIERS Les invisibles").Activate Dim i As Integer Dim SupprimeLigne As String SupprimeLigne = InputBox("Veuillez taper le numéro d'identifiant OE à supprimer", "SUPPRESSION") With ThisWorkbook.Sheets("DOSSIERS Les invisibles") 'on se positionne sur la dernière ligne de la colonne A et on remonte jusqu'à la n°2 For i = .Range("V" & .Rows.Count).End(xlUp).Row To 2 Step -1 MsgBox "Etes vous sur de vouloir supprimer de la base cet identifiant?", vbYesNo + vbInformation, "CONFIRMATION" 'If Reponse = vbYes Then 'on supprime la ligne. Rows(i).Delete End If Next i End With End Sub

Bonjour,

Plutôt que de boucler sur toutes les lignes, faire un filtre sur la valeur à supprimer et supprimer ces lignes filtrées.
Code à adapter

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Private Sub btnsupdelabasebddinv_Click()
    Dim i As Integer, DerCol As Long, DerLig As Long, col As Long
    Dim SupprimeLigne As String
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Sheets("DOSSIERS Les invisibles").Activate
    SupprimeLigne = InputBox("Veuillez taper le numéro d'identifiant OE à supprimer", "SUPPRESSION")
    Reponse = MsgBox("Etes vous sur de vouloir supprimer de la base cet identifiant?", vbYesNo + vbInformation, "CONFIRMATION")
    If Reponse = 6 Then 'vbYes
        Rows("1").Select
        If ActiveSheet.AutoFilterMode Then
            isOn = "On"
        Else
            isOn = "Off"
            Selection.AutoFilter
        End If
        DerCol = Range("XFD1").End(xlToLeft).Column
        DerLig = Range("A10000").End(xlUp).Row
        col = 22 'Colonne V
        ActiveSheet.Range(Cells(1, "A"), Cells(DerLig, DerCol)).AutoFilter Field:=col, Criteria1:=SupprimeLigne
        Range("_FilterDataBase").Offset(1, 0).Resize(, DerCol).SpecialCells(xlCellTypeVisible).Delete
    End If
    ActiveSheet.AutoFilterMode = False
    Unload UserForm1 'mettez ici le nom de votre formulaire
End Sub

Cdlt

Bonjour,

je pense quand utilisant la fonction .find ça sera plus facile.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Private Sub CommandButton2_Click()
 
Sheets("DOSSIERS Les invisibles").Activate
 
Dim SupprimeLigne As String
SupprimeLigne = InputBox("Veuillez taper le numéro d'identifiant OE à supprimer", "SUPPRESSION")
If SupprimeLigne = "" Then
Exit Sub
Else
Select Case MsgBox("Etes vous sur de vouloir supprimer de la base cet identifiant?", vbYesNo + vbInformation, "CONFIRMATION")
 Case vbYes
 Set d = Sheets("DOSSIERS Les invisibles").Range("A:A").Find(SupprimeLigne, LookIn:=xlValues, lookat:=xlWhole)
If Not d Is Nothing Then
 a = d.Row
Rows(a).Delete
Else
MsgBox "Cette identifiant n'existe pas", vbOKOnly, "SUPPRESSION"
End If
Case vbNo
Exit Sub
End Select
End If
End Sub

13/10/2019, 09h10
ARTURO83

Citation:

Envoyé par NujWex
je pense quand utilisant la fonction .find ça sera plus facile.

OK, et s'il y a plusieurs lignes à supprimer, ou est la boucle?

J'avais pas compris qu'il pouvait avoir plusieurs fois la même valeur, il suffi de faire une boucles avec .findnext

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Private Sub CommandButton2_Click()
 
Sheets("DOSSIERS Les invisibles").Activate
 
Dim SupprimeLigne As String
SupprimeLigne = InputBox("Veuillez taper le numéro d'identifiant OE à supprimer", "SUPPRESSION")
If SupprimeLigne = "" Then
Exit Sub
Else
Select Case MsgBox("Etes vous sur de vouloir supprimer de la base cet identifiant?", vbYesNo + vbInformation, "CONFIRMATION")
 Case vbYes
 Set d = Sheets("Feuil1").Range("A:A").Find(SupprimeLigne, LookIn:=xlValues, lookat:=xlWhole)
If Not d Is Nothing Then
Do
 a = d.Row
Rows(a).Delete
Set d = Sheets("DOSSIERS Les invisibles").Range("A:A").FindNext
Loop While Not d Is Nothing
Else
MsgBox "Cette identifiant n'existe pas", vbOKOnly, "SUPPRESSION"
End If
Case vbNo
Exit Sub
End Select
End If
End Sub

13/10/2019, 09h31
ARTURO83

Bien sûr, mais pensez-vous que ce sera plus rapide qu'un filtre qui efface toutes les lignes en 1 seule fois?
13/10/2019, 09h46
NujWex

Aucune idée, je ne suis pas informaticien j'ai juste adapter un code que j'utilise pour jb1975.
J'imagine qu'avec une grand base de donnée ma solution est plus lente, mais je trouve que c'est plus simple à comprendre pour des débutants en VBA.
14/10/2019, 09h02
jb1975

1 pièce(s) jointe(s)

Citation:

Envoyé par NujWex

Aucune idée, je ne suis pas informaticien j'ai juste adapter un code que j'utilise pour jb1975.
J'imagine qu'avec une grand base de donnée ma solution est plus lente, mais je trouve que c'est plus simple à comprendre pour des débutants en VBA.

Merci pour votre aide, je viens de tester sa bloque ici :

Code:

Set d = Sheets("Feuil1").Range("A:A").Find(SupprimeLigne, LookIn:=xlValues, lookat:=xlWhole)

Sachant que je la colonne V j'ai mes identifiants

je dois présenter le classeur demain pour la mise en application qui pourrait m'aider merci pour votre intervention.

Je peux vous envoyer mon classeur pour gagner du temps Pièce jointe 509754 Pièce jointe 509754 du temps

login : jamal
mdp: 123
14/10/2019, 09h07
ARTURO83

Bonjour,

Citation:

je dois présenter le classeur demain pour la mise en application qui pourrait m'aider merci pour votre intervention.

Ma proposition en #2 ne vous convient pas?

Si mais j'ai mis le code il me bloque à l'endroit que j'ai noté.

Je pris se code

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Private Sub CommandButton2_Click()
 
Sheets("DOSSIERS Les invisibles").Activate
 
Dim SupprimeLigne As String
SupprimeLigne = InputBox("Veuillez taper le numéro d'identifiant OE à supprimer", "SUPPRESSION")
If SupprimeLigne = "" Then
Exit Sub
Else
Select Case MsgBox("Etes vous sur de vouloir supprimer de la base cet identifiant?", vbYesNo + vbInformation, "CONFIRMATION")
 Case vbYes
 Set d = Sheets("DOSSIERS Les invisibles").Range("A:A").Find(SupprimeLigne, LookIn:=xlValues, lookat:=xlWhole)
If Not d Is Nothing Then
 a = d.Row
Rows(a).Delete
Else
MsgBox "Cette identifiant n'existe pas", vbOKOnly, "SUPPRESSION"
End If
Case vbNo
Exit Sub
End Select
End If
End Sub

Il me bloque ici

Code:

Set d = Sheets("DOSSIERS Les invisibles").Range("A:A").Find(SupprimeLigne, LookIn:=xlValues, lookat:=xlWhole)

J'ai aussi testé

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Private Sub btnsupdelabasebddinv_Click()
    Dim i As Integer, DerCol As Long, DerLig As Long, col As Long
    Dim SupprimeLigne As String
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Sheets("DOSSIERS Les invisibles").Activate
    SupprimeLigne = InputBox("Veuillez taper le numéro d'identifiant OE à supprimer", "SUPPRESSION")
    Reponse = MsgBox("Etes vous sur de vouloir supprimer de la base cet identifiant?", vbYesNo + vbInformation, "CONFIRMATION")
    If Reponse = 6 Then 'vbYes
        Rows("1").Select
        If ActiveSheet.AutoFilterMode Then
            isOn = "On"
        Else
            isOn = "Off"
            Selection.AutoFilter
        End If
        DerCol = Range("XFD1").End(xlToLeft).Column
        DerLig = Range("A10000").End(xlUp).Row
        col = 22 'Colonne V
        ActiveSheet.Range(Cells(1, "A"), Cells(DerLig, DerCol)).AutoFilter Field:=col, Criteria1:=SupprimeLigne
        Range("_FilterDataBase").Offset(1, 0).Resize(, DerCol).SpecialCells(xlCellTypeVisible).Delete
    End If
    ActiveSheet.AutoFilterMode = False
    Unload UserForm1 'mettez ici le nom de votre formulaire
End Sub

Il bloque ici Selection.AutoFilter

14/10/2019, 10h54
MarcelG

Bonjour,

Arturo,

1 - Les Activate et Select ne servent à rien.
2 - Bien rattacher ses objets Range en utilisant le bloc With, pour une meilleure lisibilité

Le processus que j'adopte, si le champ concerné ne contient aucune cellule vide.

1 - Remplacer la valeur test par un vide ""
2 - Supprimer les lignes entières des cellules spéciales ainsi mises à blanc

Ces méthodes sont affectées d'un bloc, donc sans balayage.

Je vous laisse traduire en langage VBA.
14/10/2019, 11h17
NujWex

Citation:

Il me bloque ici

Code:

Set d = Sheets("DOSSIERS Les invisibles").Range("A:A").Find(SupprimeLigne, LookIn:=xlValues, lookat:=xlWhole)

Chez moi le code fonctionne parfaitement.

Est-ce que la feuille qui contient les données s'appelle bien "DOSSIERS les invisibles"?
Si les données cherchées sont en colonne "V" le code doit être modifié ("A:A") devient ("V:V").

Bonjour,

A MarcelG, excellente idée que de remplacer la valeur par un vide, donc voici le code modifié

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub btnsupdelabasebddinv_Click()
    Dim  DerLig As Long
    Dim SupprimeLigne As String
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set f = Sheets("DOSSIERS Les invisibles")
    DerLig = f.[A10000].End(xlUp).Row
    SupprimeLigne = InputBox("Veuillez taper le numéro d'identifiant OE à supprimer", "SUPPRESSION")
    Reponse = MsgBox("Etes vous sur de vouloir supprimer de la base cet identifiant?", vbYesNo + vbInformation, "CONFIRMATION")
    f.Columns("V:V").Replace What:=SupprimeLigne, Replacement:="", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    If Reponse = 6 Then f.Range("V2:V" & DerLig).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

A NujWex
Ca ne marche pas (comme mon premier code), car j'ai ouvert le fichier et c'est un tableau structuré, donc certaines commandes ne passent pas.

Cdlt

14/10/2019, 11h47
jb1975

Citation:

Envoyé par NujWex

Chez moi le code fonctionne parfaitement.

Est-ce que la feuille qui contient les données s'appelle bien "DOSSIERS les invisibles"?
Si les données cherchées sont en colonne "V" le code doit être modifié ("A:A") devient ("V:V").

je vais re-tester ce soir j'ai bien remplacer les lettres à par le V.

la feuille s appelle bien DOSSIER les Invisibles
merci pour votre aide
14/10/2019, 12h30
Pierre Fauconnier

Salut

On peut aussi utiliser les filtres avancés ou PowerQuery pour extraire les lignes qui conviennent. Si c'est du "one shot", les filtres avancés sont une bonne solution. Avec PowerQuery, on peut, en cas de "one shot", supprimer la source et couper la connexion sur la table résultante. Sinon, une simple actualisation de PQ permet de mettre à jour la requête résultante.
14/10/2019, 21h01
jb1975

Citation:

Envoyé par jb1975

je vais re-tester ce soir j'ai bien remplacer les lettres à par le V.

la feuille s appelle bien DOSSIER les Invisibles
merci pour votre aide
14/10/2019, 21h50
jb1975

Citation:

Envoyé par ARTURO83

...

J'ai testé votre code dans un autre userform l'identifiant est en colonne T quand je réponds oui lorsqu'il me demande si je suis sur il me met un message d'erreur sur :

Code:

If Reponse = 6 Then f.Range("V2:V" & DerLig).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Bonjour,

Insérez une ligne pour ignorer l'erreur provoquée par l'absence de cellules vides (celles qu'occupaient auparavant l'identifiant recherché). Dans le cas présent, l'identifiant que vous voulez exclure n'existe pas.

Les 3 dernières lignes du code
Code:

1 2 3 f.Columns("T:T").Replace What:=SupprimeLigne, Replacement:="", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False On Error Resume Next If Reponse = 6 Then f.Range("T2:T" & DerLig).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Cdlt

Salut.

il faut quand même faire attention au code proposé!

Dans le code du message #18, les valeurs sont remplacées par "" à la ligne 10 avant le test de la réponse au msgbox. Même si l'utilisateur dit non, les cellules correspondant à l'ID sont mises à blanc. Je doute que ce soit ce qui est souhaité!

Pourquoi aller chercher la dernière ligne avec f.[A10000]. Pourquoi A10000? Ca ne coûte pas plus cher d'aller chercher la dernière ligne avec f.range("a1048576") ou f.range("a" & f.rows.count), tant qu'à faire. De plus, normalement, en 2019, on travaille avec des tableaux structurés pour ce genre de cas. Ca évite de devoir chercher la dernière ligne, et ça donne plus de souplesse au code puisque si le tableau est déplacé, agrandi, modifié, le code continue à fonctionner sans devoir le modifier.

Quant à l'ajout d'un On Error Resume Next pour contourner une erreur, ce n'est pas le top en programmation. Ca "masque" toutes les ~~erreurs~~ exceptions sans discrimination si elles ne sont pas évaluées après la ligne qui pose problème. Sur la ligne incriminée, l'exception levée pourrait vouloir dire que l'identifiant n'a pas été trouvé, et donc qu'il n'y a pas de cellules vides. Il serait plus judicieux de tester que l'identifiant est présent avant la suppression (un simple application.countif suffit), ce qui garantira qu'il y aura des cellules blanches après le remplacement.

Programmer à coup de "On Error" est la meilleure façon de se prendre le mur à brève échéance.

Sans tableau structuré, il est préférable de valoriser une variable de type range plutôt que de la définir à chaque ligne. Ca évite les "V:V" puis les V2:V" & derligne.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 Sub DeleteRows() Dim ID As String Dim r As Range ID = InputBox("Saisissez l'ID à supprimer svp") If ID <> "" Then Set r = Range("a2:a" & Range("a1048576").End(xlUp).Row) If Application.CountIfs(r, ID) > 0 Then If MsgBox("Voulez-vous supprimer les lignes pour cet id?", vbQuestion + vbYesNo) = vbYes Then r.Replace what:=ID, replacement:="", lookat:=xlWhole r.SpecialCells(xlCellTypeBlanks).EntireRow.Delete End If Else MsgBox "L'ID n'a pas été trouvé dans le tableau" End If Else MsgBox "Aucun ID n'a été saisi" End If End Sub

Voir 40 message(s) de cette discussion en une page