Страницы: 1
RSS
Макрос для очистки "Умных таблиц", Макрос для очистки "Умных таблиц"
 
Доброго времени суток, уважаемые форумчане!


У меня на нескольких листах есть умные таблицы, подскажите пожалуйста макрос который удалит все строки умных таблиц, на нужных, начиная с третьей строки таблицы.

Огромное спасибо!
Изменено: BRP - 18.01.2022 14:44:00
 
Добрый день!
Код
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
Изменено: webley - 18.01.2022 14:34:25
 
А как задать нужные листы, или нужные умные таблицы? Не пойму....
 
ну, задавать по разному можно - например так:
Код
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, предложил ввести список имён таблиц для удаления. Есть также множество других вариантов
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
webley,  Идеально) Спасибо!
Изменено: BRP - 18.01.2022 16:01:50
 
Код
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
Страницы: 1
Читают тему (гостей: 1)
Наверх