У меня на нескольких листах есть умные таблицы, подскажите пожалуйста макрос который удалит все строки умных таблиц, на нужных, начиная с третьей строки таблицы.
Sub LOClear()
Dim lo As ListObject, sh As Worksheet
For Each sh In ThisWorkbook.Worksheets
For Each lo In sh.ListObjects
If lo.ListRows.Count > 0 Then lo.DataBodyRange.Delete
Next lo
Next sh
MsgBox "Done"
End Sub
Но мне нужно не со всех таблиц удалить данные. К примеру у меня на 10 листах 10 умных таблиц, а очистить нужно только 5. И удалить начиная с третей строки, то есть остаться должны шапка и 2 строки таблицы...
Option Explicit
Const ROWS_COUNT = 3
Sub ClearTablesInActiveWorkbook()
ClearTablesInWorkbook ActiveWorkbook
End Sub
Sub ClearTablesInWorkbook(wb As Workbook)
Dim sh As Worksheet
For Each sh In wb.Worksheets
ClearTablesInWorksheet sh
Next
End Sub
Sub ClearTablesInWorksheet(sh As Worksheet)
Dim tb As ListObject
For Each tb In sh.ListObjects
ClearTable tb
Next
End Sub
Sub ClearTable(tb As ListObject)
Dim rn As Range
On Error Resume Next
Set rn = tb.Range
On Error GoTo 0
If Not rn Is Nothing Then
If rn.Rows.Count > ROWS_COUNT Then
rn.Cells(ROWS_COUNT + 1, 1).Resize(rn.Rows.Count - ROWS_COUNT, rn.Columns.Count).Clear
tb.Resize rn.Cells(1, 1).Resize(ROWS_COUNT, rn.Columns.Count)
End If
End If
End Sub
Sub LOClear2()
Dim lo As ListObject, sh As Worksheet
For Each sh In ThisWorkbook.Worksheets
For Each lo In sh.ListObjects
If lo.ListRows.Count > 2 Then
lo.Range.Rows("3:" & lo.DataBodyRange.Rows.Count).Delete
End If
Next lo
Next sh
MsgBox "Done"
End Sub
написал: у меня на 10 листах 10 умных таблиц, а очистить нужно только 5
Цитата
написал: который удалит все строки умных таблиц, на всех листах,
вы уж определитесь:)
а по поводу того, чтоб верхнюю строку оставить - можно так:
Код
Sub LOClear()
Dim lo As ListObject, sh As Worksheet, j As Long
For Each sh In ThisWorkbook.Worksheets
For Each lo In sh.ListObjects
For j = lo.ListRows.Count To 2 Step -1
lo.ListRows(j).Delete
Next j
Next lo
Next sh
MsgBox "Done"
End Sub
Sub LOClear()
Dim lo As ListObject, sh As Worksheet, j As Long
Dim LONames
LONames = Array("Таблица14", "Таблица13") 'список таблиц для очистки
For Each sh In ThisWorkbook.Worksheets
For Each lo In sh.ListObjects
If Not IsError(Application.Match(lo.Name, LONames, 0)) Then
For j = lo.ListRows.Count To 2 Step -1
lo.ListRows(j).Delete
Next j
End If
Next lo
Next sh
MsgBox "Done"
End Sub
BRP: макрос который удалит все строки умных таблиц, на нужных
как программе объяснить, какие вы считаете НУЖНЫМИ? webley, предложил ввести список имён таблиц для удаления. Есть также множество других вариантов
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Sub Мяу()
Dim ar, i&, sh As Worksheet
ar = Array("Таблица1", "Таблица13")
On Error Resume Next
For Each sh In ThisWorkbook.Worksheets
For i = 0 To UBound(ar)
With sh.ListObjects(ar(i))
.ListRows(3).Range.Resize(.ListRows.Count - 2).Delete
End With
Next
Next
End Sub