Supprimer une ligne d'un tableau selon la valeur d'une cellule sous VBA (sans supprimer les lignes au dessus)

MaDesn

XLDnaute Nouveau
Bonjour à tous !

Je suis en plein dans la finalisation d'un classeur excel pour aider d'autres personnes à organiser l'écriture de leurs romans. J'ai un léger problème sur une de mes macros qui vise à supprimer une fiche personnage créee par l'utilisateur. Tout ce passe bien sur 90% de la macro, sauf à un moment tout bête. Dans une de mes feuilles, j'ai un tableau avec la liste des fiches personnages que l'utilisateur a créé (ce tableau m'est utile pour créer des validations de données en liste, mais là n'est pas le souci). Je vous joints une photo du tableau (Tableau 3 qui se trouve dans la feuille "Liste personnage", sachant que l'utilisateur appuie sur un bouton déclenchant la macro dans la feuille "Personnages").

Capture d’écran 2020-10-30 à 16.22.28.png


Voici le code dans son intégralité qui marche :

VB:
Sub DelPerso()

Dim i As Integer
 Dim wb As Workbook
    Set wb = ActiveWorkbook
    Set wh = Worksheets(ActiveSheet.Name)

Sheets("Personnages").Select

   If wh.Range("D29").Value <> "" Then
  
Sheets("Personnages").Select
     Range("D30").Select
      Selection.Copy
    Range("D31").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Application.DisplayAlerts = False
Worksheets(Range("D31").Value).Delete
Application.DisplayAlerts = True
  
   Sheets("Liste personnage").Select

With ThisWorkbook.Sheets("Liste personnage")
            For i = .Range("E" & .Rows.Count).End(xlUp).Row To 2 Step -1
'je travaille sur la colonne E car mes feuilles correspondant aux fiches personnages sont nommées d'après E
'Rows.count permet de retourner le nombre de ligne de la plage range
                        If .Range("E" & i).Value = Sheets("Personnages").Range("D31").Value Then
                                    Range("A" & i & ": E" & i).Select
    Selection.ListObject.ListRows(1).Delete
                                  
                        End If
            Next i
End With

Sheets("Personnages").Select
Range("D29").Select
       Selection.ClearContents

 Else
      
    Sheets("Personnages").Select
Range("D29").Select
MsgBox "Indique le nom du personnage ou de la fiche personnage que tu souhaites supprimer."
    
    End If


End Sub

Donc, quand l'utilisateur appuie sur la macro pour supprimer la fiche personnage, la feuille correspondante se supprime sans souci et dans le cas où le nom de la fiche personnage (dans le tableau 3) se trouve en première position, je n'ai également aucun problème, la ligne correspondante se supprime parfaitement. Mais, dans le cas où le nom de ma fiche personnage se trouve un peu plus bas dans le tableau (par exemple en ligne 3 ou 4), ce sont toutes les lignes au dessus de lui et lui compris qui sont supprimés et non seulement lui. Mais par contre, le reste de la macro fonctionne bien.

Voici en particulier, le bout du code qui ne marche pas lorsque la donnée recherchée n'est pas la première du tableau :

Code:
With ThisWorkbook.Sheets("Liste personnage")
            For i = .Range("E" & .Rows.Count).End(xlUp).Row To 2 Step -1
'je travaille sur la colonne E car mes feuilles correspondant aux fiches personnages sont nommées d'après E
'Rows.count permet de retourner le nombre de ligne de la plage range
                        If .Range("E" & i).Value = Sheets("Personnages").Range("D31").Value Then
                                    Range("A" & i & ": E" & i).Select
    Selection.ListObject.ListRows(1).Delete
                                  
                        End If
            Next i
End With

Pouvez-vous m'aidez à comprendre ce qui ne va pas ? Je suis encore une novice sur vba. Merci d'avance !
 
Solution
Je viens de voir quelque chose,

Dans votre fichier en exemple, les noms des personnages dans la colonne E, sont différents par rapport à la cellule D29 (pas l'espace avant le N°).

Après correction, voici
VB:
Sub Supprimerpersonnage()
    Dim i As Long
    Dim f1 As Worksheet, f2 As Worksheet
    Dim Perso As String
    
    Set f1 = Sheets("Personnages")
    Set f2 = Sheets("Liste personnage")
    Perso = f1.Range("D29").Value
    If Perso <> "" Then
        f2.Select
        With f2
            DerLig = .ListObjects("Tableau3").DataBodyRange.Rows.Count
            Set x = .ListObjects("Tableau3").DataBodyRange.Columns(5).Find(Perso, LookAt:=xlWhole)
            If Not x Is Nothing Then
                .Range(Cells(x.Row, "A")...

cp4

XLDnaute Accro
Bonjour MaDesn,

Si j'ai bien compris, tu veux supprimer la ligne de la cellule sélectionnée.
Evite les Select/Selection ça ralenti le code
VB:
'au lieu de cette écriture'
Sheets("Personnages").Select
Range("D29").Select
       Selection.ClearContents
'celle-ci est beaucoup mieux'   
Sheets("Personnages").Range("D29").ClearContents
Essai ce code pour supprimer ta ligne
Code:
Sub supprimerLigneActive()
With ThisWokbook.Sheets("Liste personnage")
    .ActiveCell.EntireRow.Delete
End With
End Sub
 

Rouge

XLDnaute Impliqué
Bonjour,

Autre proposition:
VB:
    With ThisWorkbook.Sheets("Liste personnage")
        For i = .Range("E" & .Rows.Count).End(xlUp).Row To 2 Step -1
            If .Range("E" & i).Value = Sheets("Personnages").Range("D31").Value Then .Range("A" & i & ": E" & i).ListObject.ListRows(1).Delete
        Next i
    End With

Cdlt
 

MaDesn

XLDnaute Nouveau
Alors, je viens de tester le code de Rouge et mon problème n'a pas disparu. Une autre ligne a été supprimée en plus de celle demandée :

Capture d’écran 2020-10-31 à 00.05.06.png


Capture d’écran 2020-10-31 à 00.05.32.png


Capture d’écran 2020-10-31 à 00.05.49.png



Aussi, en regardant le code de cp4, je n'ai pas l'impression que c'est ce qui marcherait le mieux, parce que :
- L'utilisateur n'a pas accès au tableau 3. Il rentre dans une case le nom de la fiche qu'il veut supprimer et toutes les informations sur cette fiche (dont sa ligne dans le tableau 3) sont supprimés, donc on ne travaille avec une cellule active directement dans le tableau
- Mon tableau n'est pas le seul élément de la feuille "Fiche personnage", je ne peux donc pas supprimer la ligne entière mais seulement la ligne du tableau. S'il n'existe aucune solution pour ce problème, je peux faire en sorte d'isoler le tableau sur une autre feuille, mais c'était pour éviter de surchager le classeur

Par contre, je vais essayer ta manière d'écrire les codes cp4 pour alléger mes macros !
 

Pièces jointes

  • Capture d’écran 2020-10-30 à 16.22.28.png
    Capture d’écran 2020-10-30 à 16.22.28.png
    46.2 KB · Affichages: 19

Rouge

XLDnaute Impliqué
Bonjour,

Maintenant je comprends mieux, la feuille "Liste personnage" est sous la forme d'un tableau structuré, Ce dernier englobe toutes les colonnes, et vous voulez supprimer uniquement les données comprises entre A et D, chose impossible, par contre vous pouvez effacer simplement les données entre A et E.

Si vous souhaitez malgré tout supprimer cette partie, alors il faut repasser le tableau structuré en plage.

Cdlt
 

Rouge

XLDnaute Impliqué
Visiblement on ne s'est pas compris, dans la feuille "Liste personnage" , quelle est la dernière colonne?

Le tableau structuré "Tableau3", englobe -t-il cette dernière colonne? si c'est le cas la ligne entière ne s'arrête pas à E mais à cette dernière colonne, donc on ne peut pas supprimer qu'une partie de la ligne comprise entre A et E, tout ce qui suit derrière sera supprimé.

Par contre, si le tableau structuré s'arrête à la colonne E, et qu'il y a encore des données dans les autres colonnes, lors de la suppression de la ligne, toutes les données des autres colonnes ne seront plus en phase avec celles du tableau 3, tout sera décalé. Est-ce plus clair?
 

MaDesn

XLDnaute Nouveau
Le tableau 3 va de la colonne A à E, les autres colonnes de la feuille sont hors du tableau 3. Ce que je souhaite supprimer, c'est donc la ligne correspondant au nom de mon personnage allant de A à E, sans que cela perturbe le reste de la feuille. Si ce n'est pas possible, la tableau 3 peut être isolé sur une feuille à part entière, mais l'important est que la macro supprime seulement la ligne demandé et pas les lignes du dessus
 

Rouge

XLDnaute Impliqué
Je viens de voir quelque chose,

Dans votre fichier en exemple, les noms des personnages dans la colonne E, sont différents par rapport à la cellule D29 (pas l'espace avant le N°).

Après correction, voici
VB:
Sub Supprimerpersonnage()
    Dim i As Long
    Dim f1 As Worksheet, f2 As Worksheet
    Dim Perso As String
    
    Set f1 = Sheets("Personnages")
    Set f2 = Sheets("Liste personnage")
    Perso = f1.Range("D29").Value
    If Perso <> "" Then
        f2.Select
        With f2
            DerLig = .ListObjects("Tableau3").DataBodyRange.Rows.Count
            Set x = .ListObjects("Tableau3").DataBodyRange.Columns(5).Find(Perso, LookAt:=xlWhole)
            If Not x Is Nothing Then
                .Range(Cells(x.Row, "A"), Cells(x.Row, "E")).ListObject.ListRows(2).Delete
            End If
        End With
        f1.Range("D29").Value = ""
    Else
        f1.Range("D29").Select
        MsgBox "Indique le nom du personnage ou de la fiche personnage que tu souhaites supprimer."
    End If
    Set f1 = Nothing
    Set f2 = Nothing
End Sub

Cdlt
 

MaDesn

XLDnaute Nouveau
Oui c'est normal, je l'ai expliqué dans le fichier. Même si la personne entre un nom avec un espace, c'est le nom sans espace (en E dans le tableau 3) qui devient le nom de la fiche personnage pour qu'une autre formule marche sans souci. Ce nom sans espace est généré en D30, puis copier valeur en D31 pour finalement être mis en E2
 

MaDesn

XLDnaute Nouveau
C'est bon Rouge ! Je viens de tester ta macro en indiquant que l'on cherche dans la colonne 1 et tout fonctionne parfaitement ! Encore merci !

Pour ceux que cela intéresse, voici le code dans sa globalité

VB:
Sub Supprimerpersonnage()
    Dim i As Long
    Dim f1 As Worksheet, f2 As Worksheet
    Dim Perso As String
    
    Set f1 = Sheets("Personnages")
    Set f2 = Sheets("Liste personnage")
    
    
    Perso = f1.Range("D29").Value
    
    If Perso <> "" Then
    
  f1.Range("D30").Select
      Selection.Copy
    f1.Range("D31").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
        f2.Select
        
        With f2
        
            DerLig = .ListObjects("Tableau3").DataBodyRange.Rows.Count
            Set x = .ListObjects("Tableau3").DataBodyRange.Columns(1).Find(Perso, LookAt:=xlWhole)
            If Not x Is Nothing Then
                .Range(Cells(x.Row, "A"), Cells(x.Row, "E")).ListObject.ListRows(2).Delete
                
            End If
        End With
        
    f2.Range("D4").Select
    Selection.Copy
    f2.Range("D3").Select
    ActiveSheet.Paste
        
   Sheets("Personnages").Select
Application.DisplayAlerts = False
Worksheets(Range("D31").Value).Delete
Application.DisplayAlerts = True
        
        f1.Range("D29").Value = ""
        
    Else
    
        f1.Range("D29").Select
        MsgBox "Indique le nom du personnage ou de la fiche personnage que tu souhaites supprimer."
        
    End If
    Set f1 = Nothing
    Set f2 = Nothing
    
End Sub
 
Dernière édition:

Discussions similaires