Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Удалить все столбцы в умной таблице кроме указанных в списке макроса
 
#1
08.07.2026 10:35:48
Уважаемые форумчане, подскажите пожалуйста что я делаю не так?
Код
Sub ListColumnsDelete()
Dim i As Integer
For i = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
If Cells(1, i).Value <> "код" Or "торговая марка" Or "артикул" Or "наименование" Or "ЕИ" Or "RUB без НДС" Or "RUB с НДС" Or "Заказ" Then ActiveSheet.ListObjects("tblMaket").ListColumns(i).Range.Delete
Next i
End Sub
На основе вот этого макроса решил сделать удаление столбцов, но так не работает :(
Помогите пожалуйста исправить ошибку.
Изменено: AndreiSMT - 08.07.2026 10:36:17
 
 
 
#2
08.07.2026 11:21:29
а если так? )
Код
Sub ListColumnsDelete()
Dim i As Integer, j As String
For i = Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1
j = Cells(1, i).Value
If j <> "код" Or j <> "торговая марка" Or j <> "артикул" Or j <> "наименование" Or j <> "ЕИ" Or j <> "RUB без НДС" Or j <> "RUB с НДС" Or j <> "Заказ" Then ActiveSheet.ListObjects("tblMaket").ListColumns(i).Range.Delete
Next i
End Sub
Изменено: nilske - 08.07.2026 11:29:32
 
 
 
#3
08.07.2026 11:31:53
Цитата
nilske написал:
For i = Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1
тоже не работает
Изменено: AndreiSMT - 08.07.2026 11:34:25
 
 
 
#4
08.07.2026 11:35:13
Цитата
написал:
Sub ListColumnsDelete()Dim i As Integer, j As StringFor i = Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1j = Cells(1, i).ValueIf j <> "код" Or j <> "торговая марка" Or j <> "артикул" Or j <> "наименование" Or j <> "ЕИ" Or j <> "RUB без НДС" Or j <> "RUB с НДС" Or j <> "Заказ" Then ActiveSheet.ListObjects("tblMaket").ListColumns(i).Range.DeleteNext iEnd Sub
А с последним кодом все столбцы удалились
 
 
 
#5
08.07.2026 11:39:18
Код
Option Explicit

Sub ListColumnsDelete()
    Dim tbl, sd As Object, arr_columns, arr_del, n
    Set tbl = ActiveSheet.ListObjects("tblMaket")
    Set sd = CreateObject("Scripting.Dictionary")
    arr_columns = tbl.HeaderRowRange
    arr_del = Array("код", "торговая марка", "наименование")
    For Each n In arr_columns
        sd.Add n, n
    Next
    For Each n In arr_del
        If sd.Exists(n) Then tbl.ListColumns(n).Delete
    Next
End Sub
 
 
 
#6
08.07.2026 11:42:12
Msi2102, ваш вариант удаляет все указанные в макросе столбцы, но мне нужно немно иначе... Нужно что бы удаляло все столбцы кроме указанных в макросе.
 
 
 
#7
08.07.2026 11:46:29
Код
Sub ListColumnsDelete_1()
    Dim tbl, sd As Object, arr_columns, arr_del, n
    Set tbl = ActiveSheet.ListObjects("tblMaket")
    Set sd = CreateObject("Scripting.Dictionary")
    arr_columns = tbl.HeaderRowRange
    arr_del = Array("код", "торговая марка", "наименование")
    For Each n In arr_del
        sd.Add n, n
    Next
    For Each n In arr_columns
        If Not sd.Exists(n) Then tbl.ListColumns(n).Delete
    Next
End Sub
 
 
 
#8
08.07.2026 11:51:58
Msi2102, да, теперь работает. Большое вам спасибо!
 
 
 
Страницы: 1
Читают тему
Наверх