Удалить все строки данных из таблицы Excel (кроме первого)

Question

Совсем недавно я пытался удалить все строки данных в таблице, кроме первого (который должен быть просто очищен)

Некоторые из действующих таблиц уже не может быть строк, поэтому я запускал его для проблем, так как использование .DataBodyRange.Rows.Count в таблице без строк (только заголовок и/или нижний колонтитул) вызывает ошибки.

Я искал все решения и не мог найти целую, поэтому я надеюсь, что мой ответ на этот вопрос будет полезен другим в будущем.

Answer 1

Ваш код может быть сужен до

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 

Edit:

На стороне примечания я бы добавил правильную обработку ошибок, если мне нужно интуитивно настроить пользователя, будет ли первая строка или другие строки были удалены или нет

Answer 2

Это VBA Sub удалит все строки данных (кроме первого, который он просто будет ясно) -

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 

Answer 3

Будет ли это работать на вас? Я тестировал его в Excel 2010, и он отлично работает. Это работает с таблицей под названием «Table1», который использует столбцы А через G.

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

Answer 4

Я хотел сохранить формулы в месте, что приведенный выше код не делать.

Вот что я делал, обратите внимание, что это оставляет одну пустую строку в таблице.

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 не спрашивайте меня, почему!)

Answer 5

Я предлагаю первые clearcontents, затем изменить размер таблицы:

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 

Answer 6

Это, как я очистить данные:

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

Answer 7

У меня есть 3 процедуры, которые работают нормально, просто выберите ячейку стол и запустить одну из подпрограмм

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

и термоусадочная таблицу для удаления databody диапазона, за исключением из него Адерс и первые данные строки

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

и удалить таблицу, чтобы полностью удалить таблицу из листа

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

Answer 8

Коды выше, не будет работать в Excel 2010 Мой код ниже позволяет пройти количество листов, которые вы хотите, затем выберите таблицы и удалите строки

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