Очистить умную таблицу excel vba - Word и Excel - помощь в работе с программами

BRP

Пользователь

Сообщений: 213
Регистрация: 27.12.2016

Доброго времени суток, уважаемые форумчане!

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

Огромное спасибо!

Изменено: BRP — 18.01.2022 14:44:00

webley

Пользователь

Сообщений: 1995
Регистрация: 01.01.1970

18.01.2022 14:12:28

Добрый день!

Код

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

BRP Пользователь Сообщений: 213 Регистрация: 27.12.2016	Работает отлично! Но мне нужно не со всех таблиц удалить данные. К примеру у меня на 10 листах 10 умных таблиц, а очистить нужно только 5. И удалить начиная с третей строки, то есть остаться должны шапка и 2 строки таблицы…

МатросНаЗебре

Пользователь

Сообщений: 5516
Регистрация: 05.02.2014

18.01.2022 14:26:41

Код

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

DANIKOLA

Пользователь

Сообщений: 424
Регистрация: 17.08.2019

18.01.2022 14:32:11

Код

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

webley

Пользователь

Сообщений: 1995
Регистрация: 01.01.1970

18.01.2022 14:34:03

Цитата
написал: у меня на 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

BRP Пользователь Сообщений: 213 Регистрация: 27.12.2016	А как задать нужные листы, или нужные умные таблицы? Не пойму….

webley

Пользователь

Сообщений: 1995
Регистрация: 01.01.1970

18.01.2022 14:58:59

ну, задавать по разному можно — например так:

Код

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

Jack Famous

Пользователь

Сообщений: 10852
Регистрация: 07.11.2014

OS: Win 8.1 Корп. x64 | Excel 2016 x64: | Browser: Chrome

18.01.2022 15:20:07

Цитата
BRP: макрос который удалит все строки умных таблиц, на нужных

как программе объяснить, какие вы считаете НУЖНЫМИ?
webley, предложил ввести список имён таблиц для удаления. Есть также множество других вариантов

Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄

BRP Пользователь Сообщений: 213 Регистрация: 27.12.2016	webley, Идеально) Спасибо! Изменено: BRP — 18.01.2022 16:01:50

RAN

Пользователь

Сообщений: 7091
Регистрация: 21.12.2012

#11

18.01.2022 16:14:09

Код

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

Источник

Работа с умной таблицей из кода VBA Excel. Обращение к ячейкам, строкам и столбцам умной таблицы. Добавление и удаление строк и столбцов.

Обращение к умной таблице

Все примеры кода в этой статье привязаны к таблице с именем «Таблица1», расположенной на активном листе:

Обращение к умной таблице:

ActiveSheet.ListObjects(«Таблица1»)

Обращение к диапазону умной таблицы на рабочем листе:

ActiveSheet.ListObjects(«Таблица1»).Range

Проверяем:

Debug.Print ActiveSheet.ListObjects(«Таблица1»).Range.Address ‘Результат: $B$3:$G$9

Далее все примеры кода VBA Excel, чтобы их не дублировать, будут представлены как аргументы метода Debug.Print.

Обращение к строкам

Работа с умной таблицей — обращение к строке заголовков:

Debug.Print ActiveSheet.ListObjects(«Таблица1»).Range.Rows(1).Address ‘Результат: $B$3:$G$3

Таким же образом можно обращаться и к остальным строкам таблицы (Строка1-Строка6), указывая индекс нужной строки от 2 до 7.

К записям таблицы (Строка1-Строка6) обращаются через коллекцию ListRows, указывая индекс записи от 1 до 6:

With ActiveSheet.ListObjects(«Таблица1»)

Debug.Print .ListRows.Count ‘Результат: 6

Debug.Print .ListRows(1).Range.Address ‘Результат: $B$4:$G$4

Debug.Print .ListRows(2).Range.Address ‘Результат: $B$5:$G$5

End With

Обращение к столбцам

Обращение к третьему столбцу умной таблицы из кода VBA Excel:

With ActiveSheet.ListObjects(«Таблица1»)

‘Обращение через диапазон умной таблицы

Debug.Print .Range.Columns(3).Address ‘Результат: $D$3:$D$9

Debug.Print .Range.Columns.Count ‘Результат: 6

‘Обращение через коллекцию ListColumns

Debug.Print .ListColumns(3).Range.Address ‘Результат: $D$3:$D$9

Debug.Print .ListColumns.Count ‘Результат: 6

End With

Обращение к ячейкам

Работа с умной таблицей — обращение к ячейке «E7» с отображением ее значения:

With ActiveSheet.ListObjects(«Таблица1»)

Debug.Print .Range.Cells(5, 4) ‘Результат: 91

Debug.Print .ListColumns(4).Range(5) ‘Результат: 91

Debug.Print .ListRows(4).Range(4) ‘Результат: 91

End With

Вставка и удаление строк

Вставка новой строки в конец умной таблицы:

ActiveSheet.ListObjects(«Таблица1»).ListRows.Add

Удаление последней строки:

With ActiveSheet.ListObjects(«Таблица1»)

.ListRows(.ListRows.Count).Delete

End With

Вставка новой строки на место пятой записи (Строка5 в таблице) со сдвигом пятой и нижерасположенных записей вниз:

ActiveSheet.ListObjects(«Таблица1»).ListRows.Add 5

Удаление пятой строки:

ActiveSheet.ListObjects(«Таблица1»).ListRows(5).Delete

Вставка и удаление столбцов

Вставка нового столбца в конец умной таблицы из кода VBA Excel:

ActiveSheet.ListObjects(«Таблица1»).ListColumns.Add

Удаление последнего столбца:

With ActiveSheet.ListObjects(«Таблица1»)

.ListColumns(.ListColumns.Count).Delete

End With

Вставка нового столбца на место четвертой графы таблицы со сдвигом четвертой и последующих граф вправо:

ActiveSheet.ListObjects(«Таблица1»).ListColumns.Add 4

Удаление четвертого столбца таблицы:

ActiveSheet.ListObjects(«Таблица1»).ListColumns(4).Delete

Создание и удаление умной таблицы описано в статье VBA Excel. Создание таблицы (умной, обычной)

Источник

ILF_ollie

2 / 2 / 0

Регистрация: 19.08.2010

Сообщений: 70

Удаление строк из умной таблицы по условию

10.06.2016, 12:33. Показов 12999. Ответов 6

Метки нет (Все метки)

Добрый день, уважаемые форумчане.
Имеется кусок кода, который удаляет строки по условию
При этом удаляется строка целиком.
Подскажите, пожалуйста, как можно доработать код, чтобы удалялась только строка умной таблицы.
Пробовал вместо delra.EntireRow.Delete использовать ListRow, но не работает

Visual Basic

Dim Ra As Range, delra As Range, cell As Range
    Set Ra = Application.Range("Table1[Name]")
  
    For Each cell In Ra.Cells
    If (cell = "") Then
    
    If delra Is Nothing Then Set delra = cell Else Set delra = Union(delra, cell)
    End If
    Next cell
 
    If Not delra Is Nothing Then delra.EntireRow.Delete

С уважением,

KoGG

5590 / 1580 / 406

Регистрация: 23.12.2010

Сообщений: 2,366

Записей в блоге: 1

10.06.2016, 13:41

Visual Basic

1	If Not delra Is Nothing Then Intersect(delra.EntireRow, [Table1]).Delete Shift:=xlUp

pashulka

4131 / 2235 / 940

Регистрация: 01.12.2010

Сообщений: 4,624

10.06.2016, 13:53

Можно ещё и так :

Visual Basic

Private Sub Test()
    Dim iSource As Range, iRow&, iArr 'As Variant
    Set iSource = Application.Range("Table1[Name]")
  
    If Application.CountIf(iSource, "") > 0 Then
       Application.ScreenUpdating = False
       
       iArr = iSource.Value
       For iRow = UBound(iArr) To 1 Step -1
           If Len(iArr(iRow, 1)) = 0 Then iSource(iRow).Delete
       Next
       
       Application.ScreenUpdating = True
    Else
       MsgBox "Нет данных, подлежащих удалению", , ""
    End If
End Sub

1 / 1 / 0

Регистрация: 23.06.2015

Сообщений: 2

09.02.2018, 16:21

Ваш, вариант почему-то удалил столбец с условиями. А KoGG 100% рабочую поправочку дал.

4131 / 2235 / 940

Регистрация: 01.12.2010

Сообщений: 4,624

09.02.2018, 20:03

kislotik, Если решили начать с притензий, то опубликуйте(выложите) свою таблицу(или часть), где кроме удаления строк «умной» таблицы будут удалены и данные, которые не относятся к этой таблице. И, разумеется, не забудьте указать Вашу версию Excel.

kislotik

1 / 1 / 0

Регистрация: 23.06.2015

Сообщений: 2

09.02.2018, 21:25

Прошу прощения уважаемый pashulka, никаких претензий, код не сработал исключительно в моем случае. Так, как я решил свою проблему кодом выше, истязаться экспериментами к сожалению нет ни времени ни желания.

Код ниже, который у меня заработал.
С отключением событий в

моем случае

работает гораздо быстрее.

Visual Basic

Application.EnableEvents = False
Dim Ra As Range, delra As Range, cell As Range
    Set Ra = Application.Range("Table1[Name]")
  
    For Each cell In Ra.Cells
    If (cell = "") Then
    
    If delra Is Nothing Then Set delra = cell Else Set delra = Union(delra, cell)
    End If
    Next cell
 
   If Not delra Is Nothing Then Intersect(delra.EntireRow, [Table1]).Delete Shift:=xlUp
Application.EnableEvents = True
End Sub

Извините если неправильно был понят.

4131 / 2235 / 940

Регистрация: 01.12.2010

Сообщений: 4,624

09.02.2018, 21:36

Не должен мой код удалять ничего, кроме строк умной таблицы, без относительно личности поэтому файл-пример важен.

P.S. Возможно причины неудач кроятся в коде событий, но это гадание …

Источник

При очистке «умной таблицы»макросом слетают формулы

Sancho

Дата: Пятница, 08.07.2016, 14:15 |
Сообщение № 1

Группа: Проверенные

Ранг: Обитатель

Сообщений: 279

Репутация:
19
±

Замечаний:
0% ±

2007, 2010, 2013

Всем привет!
Наткнулся на проблему при очистке макросом перед заполнением «умной таблицы» — слетают формулы, расположенные в столбце C, ссылающиеся на ячейки в «умной таблице» на #ССЫЛКА. причем те формулы которые расположены в той же строке на какую ссылается формула то все нормально. Если выделить столбец таблицы вручную и нажать клавишу del то все формулы не слетают.
Записал макрос на очистку перед заполнением кнопкой del получил Selection.ClearContents, подставил вместо Selection.Clear — все равно при очистке макросом формулы «слетают».

Каким еще способом можно очистить таблицу без потери формул?

К сообщению приложен файл:

12.xlsm
(21.4 Kb)

Ответить

Саня

Дата: Пятница, 08.07.2016, 14:33 |
Сообщение № 2

Группа: Друзья

Ранг: Ветеран

Сообщений: 1067

Репутация:
560
±

Замечаний:
0% ±

XL 2016

[vba]

Код

    ActiveSheet.Range(Cells(2, 13), Cells(Rows.Count, Cells(2, 13).Column).End(xlUp)).RemoveDuplicates Columns:=1, Header:=xlNo ‘Cells(Rows.Count, 1).End(xlUp).Row
    ActiveSheet.Range(Cells(2, 13), Cells(Rows.Count, Cells(2, 13).Column).End(xlUp)).Copy  ‘ Cut       ‘<<< ИЗМЕНИЛ!
    Range(«Таблица2[1]»).Select

ActiveSheet.Paste
ActiveSheet.Range(Cells(2, 13), Cells(Rows.Count, Cells(2, 13).Column).End(xlUp)).ClearContents ‘<<< ДОБАВИЛ!

[/vba]

формулы убились не из-за очистки, а из-за наката вырезанием на диапазон

Ответить

krosav4ig

Дата: Пятница, 08.07.2016, 14:36 |
Сообщение № 3

Группа: Друзья

Ранг: Старожил

Сообщений: 2346

Репутация:
989
±

Замечаний:
0% ±

Excel 2007,2010,2013

а я пишу [vba]

Код

ActiveSheet.ListObjects(1).DataBodyRange.Clear

[/vba] и у мну ничего не слетает

UPD.
[vba]

Код

Sub Макрос1()
    Application.ScreenUpdating = 0
        With ActiveSheet.ListObjects(1)
            If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
            [1!O1:O33].AdvancedFilter xlFilterCopy, , [1!M1], True
            [1!M:M].SpecialCells(2, 23).Copy
            .HeaderRowRange(1, 1).PasteSpecial xlPasteValues
            [1!M:M].Clear
        End With
    Application.ScreenUpdating = True
End Sub

[/vba]

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig — Пятница, 08.07.2016, 15:01

Ответить

Sancho

Дата: Пятница, 08.07.2016, 20:39 |
Сообщение № 4

Группа: Проверенные

Ранг: Обитатель

Сообщений: 279

Репутация:
19
±

Замечаний:
0% ±

2007, 2010, 2013

формулы убились не из-за очистки, а из-за наката вырезанием на диапазон

да,… я когда уже отправил, курить пошел размышлять вдруг осенило отключить блок вставки и перестали слетать формулы, но уже не было возможности отписаться, что я неправильный вопрос задал. Прошу прощения… и спасибо за подсказки.

Сообщение отредактировал Sancho — Пятница, 08.07.2016, 20:40

Ответить

Источник

Автор vasa, 21 марта 2017, 14:44

vasa

Посетитель форума
Сообщения: 31
Записан

Есть умная таблица, в которой нужно удалить строки вместе с форматированием из диапазона.
Нужно удалить строки с 4 по последнюю.
Пробовал различные варианты, но форматы не удаляются.
Помогите, пожалуйста!

Администратор

Administrator
Сообщения: 2,254
Записан

Sub Макрос()

Dim shMat As Worksheet, lr As Long

‘1. Присваиваем листу «Материалы» имя «shMat», чтобы удобнее писать код.
Set shMat = Sheets(«Материалы»)
‘2. Поиск последней строки по столбцу «A».
‘ При использовании метода «End» не должно быть скрытых строк на листе.
lr = shMat.Cells(shMat.Rows.Count, «A»).End(xlUp).Row
‘3. Удаление строк с 4 по последнюю.
shMat.Rows(«4:» & lr).Columns(«A:C»).Delete Shift:=xlUp

End Sub

vasa

Посетитель форума
Сообщения: 31
Записан

Все работает правильно.
Большое спасибо.

Администратор

Administrator
Сообщения: 2,254
Записан

Если используется умная таблица, то можно не искать последнюю строку.
Этот макрос удаляет в умной таблице строки с 4 по последнюю.

Sub Макрос()

Dim shMat As Worksheet, tbl As ListObject

‘1. Присваиваем листу «Материалы» имя «shMat», чтобы удобнее писать код.
Set shMat = Sheets(«Материалы»)
‘2. Присваиваем умной таблице имя «tbl».
Set tbl = shMat.ListObjects(«Таблица1»)
‘3. Удаление строк с 4 по последнюю.
tbl.Range.Rows(«4:» & tbl.Range.Rows.Count).Delete Shift:=xlUp

End Sub

Форум по VBA, Excel и Word
►
VBA, Excel
►
VBA, макросы в Excel
►
Excel Макрос: Как удалить строки вместе с форматом в умной таблице

Источник