Возникла необходимость написать пару макросов для работы, но ранее никогда этого не делал и возникла проблема с одним из них. Нужно из таблицы удалить все столбцы, которые в первой строке НЕ содержат набор слов. Если бы их нужно было удалить, то это с легкостью можно было бы сделать так:
[vba]
Код
Sub Delete_columns() Dim i& List = Array("Column1", "Column2", "Column3") 'список слов' Application.ScreenUpdating = False For i = Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1 For Each word In List If Cells(1, i) = word Then Columns(i).Delete Next word Next Application.ScreenUpdating = True End Sub
[/vba]
Но мне наоборот нужно такие столбцы не удалять, и замена '=' на '<>' здесь не поможет, так как тогда он вообще последовательно всю таблицу удалит. Есть вариант, но мне он кажется слишком некрасивым, хотелось бы, чтобы была возможность задать массив значений как в первом примере (а не перечислять в if кучу условий):
[vba]
Код
Sub Delete_columns() Dim i& Application.ScreenUpdating = False For i = Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1 If Cells(1, i) = "Column1" AND If Cells(1, i) = "Column2" AND If Cells(1, i) = "Column3" Then Columns(i).Delete Next Application.ScreenUpdating = True End Sub
[/vba] Заранее спасибо.
Добрый день.
Возникла необходимость написать пару макросов для работы, но ранее никогда этого не делал и возникла проблема с одним из них. Нужно из таблицы удалить все столбцы, которые в первой строке НЕ содержат набор слов. Если бы их нужно было удалить, то это с легкостью можно было бы сделать так:
[vba]
Код
Sub Delete_columns() Dim i& List = Array("Column1", "Column2", "Column3") 'список слов' Application.ScreenUpdating = False For i = Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1 For Each word In List If Cells(1, i) = word Then Columns(i).Delete Next word Next Application.ScreenUpdating = True End Sub
[/vba]
Но мне наоборот нужно такие столбцы не удалять, и замена '=' на '<>' здесь не поможет, так как тогда он вообще последовательно всю таблицу удалит. Есть вариант, но мне он кажется слишком некрасивым, хотелось бы, чтобы была возможность задать массив значений как в первом примере (а не перечислять в if кучу условий):
[vba]
Код
Sub Delete_columns() Dim i& Application.ScreenUpdating = False For i = Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1 If Cells(1, i) = "Column1" AND If Cells(1, i) = "Column2" AND If Cells(1, i) = "Column3" Then Columns(i).Delete Next Application.ScreenUpdating = True End Sub
Sub Delete_columns() Dim i&, j& List = Array("Column1", "Column2", "Column3") Application.ScreenUpdating = False For i = Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1 j = 0 For Each word In List If Cells(1, i) = word Then j = j + 1 Next word If j = 0 Then Columns(i).Delete Next Application.ScreenUpdating = True End Sub
[/vba]
ну если в лоб: [vba]
Код
Sub Delete_columns() Dim i&, j& List = Array("Column1", "Column2", "Column3") Application.ScreenUpdating = False For i = Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1 j = 0 For Each word In List If Cells(1, i) = word Then j = j + 1 Next word If j = 0 Then Columns(i).Delete Next Application.ScreenUpdating = True End Sub
Sub Delete_columns() Dim rng As Range, cell As Range, tmp As Range, s, Addr$ For Each s In Array("Column1", "Column2", "Column3") Set rng = ActiveSheet.UsedRange.Rows(1) Set cell = rng.Find(s, , xlValues, xlWhole) If Not cell Is Nothing Then Addr = cell.Address Do If tmp Is Nothing Then _ Set tmp = cell Else _ Set tmp = Union(tmp, cell) Set cell = rng.FindNext(cell) Loop Until cell.Address = Addr End If Next If Not tmp Is Nothing Then tmp.EntireColumn.Delete End Sub
[/vba]
еще вариантик [vba]
Код
Sub Delete_columns() Dim rng As Range, cell As Range, tmp As Range, s, Addr$ For Each s In Array("Column1", "Column2", "Column3") Set rng = ActiveSheet.UsedRange.Rows(1) Set cell = rng.Find(s, , xlValues, xlWhole) If Not cell Is Nothing Then Addr = cell.Address Do If tmp Is Nothing Then _ Set tmp = cell Else _ Set tmp = Union(tmp, cell) Set cell = rng.FindNext(cell) Loop Until cell.Address = Addr End If Next If Not tmp Is Nothing Then tmp.EntireColumn.Delete End Sub
buchlotnik, можно чуть упростить и ускорить (т.к. из внутреннего цикла будет выходить при первом же совпадении, а не гонять перебор до конца списка слов): [vba]
Код
Sub Delete_Columns() Dim i& List = Array("Column1", "Column2", "Column3") ' список слов Application.ScreenUpdating = False For i = Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1 For Each word In List If Cells(1, i) = word Then Exit For Next word If IsEmpty(word) Then Columns(i).Delete Next Application.ScreenUpdating = True End Sub
[/vba]
buchlotnik, можно чуть упростить и ускорить (т.к. из внутреннего цикла будет выходить при первом же совпадении, а не гонять перебор до конца списка слов): [vba]
Код
Sub Delete_Columns() Dim i& List = Array("Column1", "Column2", "Column3") ' список слов Application.ScreenUpdating = False For i = Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1 For Each word In List If Cells(1, i) = word Then Exit For Next word If IsEmpty(word) Then Columns(i).Delete Next Application.ScreenUpdating = True End Sub
Sub Delete_Columns() Dim i& List = "|Column1|Column2|Column3|" ' список слов Application.ScreenUpdating = False For i = Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1 If InStr(List, "|" & Cells(1, i) & "|") = 0 Then Columns(i).Delete Next Application.ScreenUpdating = True End Sub
[/vba]
Можно один цикл убрать: [vba]
Код
Sub Delete_Columns() Dim i& List = "|Column1|Column2|Column3|" ' список слов Application.ScreenUpdating = False For i = Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1 If InStr(List, "|" & Cells(1, i) & "|") = 0 Then Columns(i).Delete Next Application.ScreenUpdating = True End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
