web-dev-qa-db-fra.com

Supprimer toutes les lignes de données d'un tableau Excel (à l'exception de la première)

Récemment, j'ai essayé de supprimer toutes les lignes de données d'une table, à l'exception de la première (qui doit simplement être effacée).

Certaines des tables en cours d’action pouvaient déjà ne comporter aucune ligne. Je l’exécutais donc avec des problèmes, car l’utilisation de .DataBodyRange.Rows.Count sur une table sans lignes (uniquement l’en-tête et/ou le pied de page) provoquait des erreurs.

J'ai cherché partout une solution et je ne pouvais pas en trouver une solution complète. J'espère donc que ma réponse à cette question sera utile aux autres à l'avenir.

excel-vbaexcel-2007vbaexcel
11
David Gard

Votre code peut être réduit à

Sub DeleteTableRows(ByRef Table As ListObject)
    On Error Resume Next
    '~~> Clear Header Row `IF` it exists
    Table.DataBodyRange.Rows(1).ClearContents
    '~~> Delete all the other rows `IF `they exist
    Table.DataBodyRange.Offset(1, 0).Resize(Table.DataBodyRange.Rows.Count - 1, _
    Table.DataBodyRange.Columns.Count).Rows.Delete
    On Error GoTo 0
End Sub

Modifier :

Sur une note de côté, j'ajouterais le traitement d'erreur approprié si je dois indiquer à l'utilisateur si la première ligne ou les autres lignes ont été supprimées ou non.

14
Siddharth Rout

Voici comment je supprime les données:

Sub Macro3()
    With Sheet1.ListObjects("Table1")
        If Not .DataBodyRange Is Nothing Then
            .DataBodyRange.Delete
        End If
    End With
End Sub
18
royUK

J'ai 3 routines qui fonctionnent très bien, il suffit de sélectionner une cellule dans un tableau et d'exécuter l'un des sous-programmes

Sub ClearTable()
If Not ActiveCell.ListObject Is Nothing Then
    ActiveCell.ListObject.DataBodyRange.Rows.ClearContents
End If
End Sub

et Shrink Table pour supprimer la plage de corps de données, à l’exception des en-têtes et de la première ligne de données

Sub ShrinkTable()
If Not ActiveCell.ListObject Is Nothing Then
    ActiveCell.ListObject.DataBodyRange.Delete
End If
End Sub

et supprimer le tableau pour supprimer complètement le tableau de la feuille

Sub DeleteTable()
If Not ActiveCell.ListObject Is Nothing Then
    ActiveCell.ListObject.Delete
End If
End Sub
4
Erik

Est-ce que cela fonctionnerait pour vous? Je l'ai testé dans Excel 2010 et tout fonctionne correctement ..__ Ceci fonctionne avec une table appelée "Table1" qui utilise les colonnes A à G.

Sub Clear_Table()
    Range("Table1").Select
    Application.DisplayAlerts = False
    Selection.Delete
    Application.DisplayAlerts = True
    Range("A1:G1").Select
    Selection.ClearContents
End Sub
4
Jack McCoy

Je voulais garder les formules en place, ce que le code ci-dessus n'a pas fait. 

Voici ce que j'ai fait, notez que cela laisse une ligne vide dans le tableau.

Sub DeleteTableRows(ByRef Table As ListObject, KeepFormulas as boolean)

On Error Resume Next

if not KeepFormulas then
    Table.DataBodyRange.clearcontents
end if

Table.DataBodyRange.Rows.Delete

On Error GoTo 0

End Sub

(PS ne me demande pas pourquoi!) 

3
HarveyFrench

Les codes ci-dessus ne fonctionneraient pas dans Excel 2010 Mon code ci-dessous vous permet de parcourir le nombre de feuilles que vous souhaitez, puis de sélectionner des tableaux et de supprimer des lignes. 

Sub DeleteTableRows()
Dim table As ListObject
Dim SelectedCell As Range
Dim TableName As String
Dim ActiveTable As ListObject

'select ammount of sheets want to this to run
For i = 1 To 3
    Sheets(i).Select
    Range("A1").Select
    Set SelectedCell = ActiveCell
    Selection.AutoFilter

    'Determine if ActiveCell is inside a Table
    On Error GoTo NoTableSelected
    TableName = SelectedCell.ListObject.Name
    Set ActiveTable = ActiveSheet.ListObjects(TableName)
    On Error GoTo 0

    'Clear first Row
    ActiveTable.DataBodyRange.Rows(1).ClearContents
    'Delete all the other rows `IF `they exist
    On Error Resume Next
    ActiveTable.DataBodyRange.Offset(1, 0).Resize(ActiveTable.DataBodyRange.Rows.Count - 1, _
    ActiveTable.DataBodyRange.Columns.Count).Rows.Delete
    Selection.AutoFilter
    On Error GoTo 0
Next i
Exit Sub
'Error Handling
NoTableSelected:
  MsgBox "There is no Table currently selected!", vbCritical

End Sub
0
Tariq Khalaf

Je suggère d'abord clearcontents, puis redimensionner le tableau:

Sub DeleteTableRows(ByRef Table As ListObject)

     Dim R               As Range

On Error Resume Next

    Table.DataBodyRange.ClearContents
    Set R = Table.Range.Rows(1).Resize(2)
    Table.Resize R

On Error GoTo 0

End Sub
0
Max Makhrov

Ce VBA Sub supprimera toutes les lignes de données (sauf la première, qu’il effacera simplement)

Sub DeleteTableRows(ByRef Table as ListObject)

        '** Work out the current number of rows in the table
        On Error Resume Next                    ' If there are no rows, then counting them will cause an error
        Dim Rows As Integer
        Rows = Table.DataBodyRange.Rows.Count   ' Cound the number of rows in the table
        If Err.Number <> 0 Then                 ' Check to see if there has been an error
            Rows = 0                            ' Set rows to 0, as the table is empty
            Err.Clear                           ' Clear the error
        End If
        On Error GoTo 0                         ' Reset the error handling

        '** Empty the table *'
        With Table
            If Rows > 0 Then ' Clear the first row
                .DataBodyRange.Rows(1).ClearContents
            End If
            If Rows > 1 Then ' Delete all the other rows
                .DataBodyRange.Offset(1, 0).Resize(.DataBodyRange.Rows.Count - 1, .DataBodyRange.Columns.Count).Rows.Delete
            End If
        End With

End Sub
0
David Gard