Удаление столбцов по условию

[Никола]

Всем привет!   
Очень нужна помощь сделать макрос поиска в значения, который бы в зависимости от  варианта обрабатываемой таблицы удалял бы определенные столбцы. То, что мне удалось скомпилировать самому пригодно лишь для общего понимания вопроса. А так, удалив несколько столбцов, все зависает.

Код: (vb)

Sub VxAD()
' ------------------------------ удаление за U / VxAD ----------------------------------------

    Dim cell As Range
    For Each cell In [U1:U1000]
        If Trim(cell.Value) = "ВСЕГО затрат, руб." Then ' в ячейке находится число или текст

       Columns("V:AD").Select
       Selection.Delete Shift:=xlToLeft

       Columns("M:T").Select
       Selection.Delete Shift:=xlToLeft

       Columns("H:J").Select
       Selection.Delete Shift:=xlToLeft

       Columns("B:F").Select
       Selection.Delete Shift:=xlToLeft
   
       Application.Run "Nextyon"
   End If

        If Trim(cell.Value) <> "ВСЕГО затрат, руб." Then ' в не ячейке находится число или текст
       Application.Run "WxAD"
   End If
    Next

End Sub

Sub WxAD()
' ------------------------------ удаление за V / W:AD ----------------------------------------

Dim cell As Range
    For Each cell In [V1:V1000]
        If Trim(cell.Value) = "ВСЕГО затрат, руб." Then ' в ячейке находится число или текст

       Columns("W:AD").Select
       Selection.Delete Shift:=xlToLeft

       Columns("N:U").Select
       Selection.Delete Shift:=xlToLeft

       Columns("H:K").Select
       Selection.Delete Shift:=xlToLeft

       Columns("B:F").Select
       Selection.Delete Shift:=xlToLeft

       Application.Run "Nextyon"

   End If

        If Trim(cell.Value) <> "ВСЕГО затрат, руб." Then ' в ячейке находится число или текст
       Application.Run "XxAD"

   End If
    Next
End Sub

Sub XxAD()
' ------------------------------ удаление за W / X:AD ----------------------------------------

Dim cell As Range
    For Each cell In [W1:W1000]
        If Trim(cell.Value) = "ВСЕГО затрат, руб." Then ' в ячейке находится число или текст

       Columns("X:AD").Select
       Selection.Delete Shift:=xlToLeft
   
       Columns("M:V").Select
       Selection.Delete Shift:=xlToLeft

       Columns("H:J").Select
       Selection.Delete Shift:=xlToLeft
   
       Columns("B:F").Select
       Selection.Delete Shift:=xlToLeft

       Application.Run "Nextyon"

   End If

        If Trim(cell.Value) <> "ВСЕГО затрат, руб." Then ' в ячейке находится число или текст

       Application.Run "YxAD"

   End If
    Next
End Sub

Sub YxAD()

' ------------------------------ удаление за X / Y:AD ----------------------------------------

Dim cell As Range
    For Each cell In [X1:X1000]
        If Trim(cell.Value) = "ВСЕГО затрат, руб." Then ' в ячейке находится число или текст

       Columns("Y:AD").Select
       Selection.Delete Shift:=xlToLeft

       Columns("N:V").Select
       Selection.Delete Shift:=xlToLeft

       Columns("H:K").Select
       Selection.Delete Shift:=xlToLeft

       Columns("B:F").Select
       Selection.Delete Shift:=xlToLeft

       Application.Run "Nextyon"

   End If

        If Trim(cell.Value) <> "ВСЕГО затрат, руб." Then ' в ячейке находится число или текст

       Application.Run "ZxAD"

   End If
    Next
End Sub

Sub ZxAD()

' ------------------------------ удаление за Y / Z:AD ----------------------------------------
Dim cell As Range
    For Each cell In [Y1:Y1000]
        If Trim(cell.Value) = "ВСЕГО затрат, руб." Then ' в ячейке находится число или текст

       Columns("Z:AD").Select
       Selection.Delete Shift:=xlToLeft

       Columns("N:X").Select
       Selection.Delete Shift:=xlToLeft

       Columns("H:K").Select
       Selection.Delete Shift:=xlToLeft

       Columns("B:F").Select
       Selection.Delete Shift:=xlToLeft

       Application.Run "Nextyon"

   End If

        If Trim(cell.Value) <> "ВСЕГО затрат, руб." Then ' в ячейке находится число или текст

       Application.Run "AAxAD"

   End If
    Next
End Sub

Sub AAxAD()

' ------------------------------ удаление за Z / AA:AD ----------------------------------------
Dim cell As Range
    For Each cell In [Z1:Z1000]
        If Trim(cell.Value) = "ВСЕГО затрат, руб." Then ' в ячейке находится число или текст

       Columns("AA:AD").Select
       Selection.Delete Shift:=xlToLeft

       Columns("N:Y").Select
       Selection.Delete Shift:=xlToLeft

       Columns("H:K").Select
       Selection.Delete Shift:=xlToLeft

       Columns("B:F").Select
       Selection.Delete Shift:=xlToLeft

       Application.Run "Nextyon"

   End If

        If Trim(cell.Value) <> "ВСЕГО затрат, руб." Then ' в ячейке находится число или текст

       Application.Run "Nextyon"

   End If
    Next
End Sub

Sub Nextyon()
' --------------------------------------------------------------------------------------------
End Sub

[Дмитрий Щербаков(The_Prist)]

Лучше своими словами опишите, что и по каким условиям должно удаляться.

[Никола]

Лучше своими словами опишите, что и по каким условиям должно удаляться.

Смысл в том, что обрабатываются таблицы смет, в которых очень много скрытых и пустых ячеек. По каким-то причинам при формировании некоторых смет, позиция информации в них меняется.  То, что было обычно расположено в столбе X, стало располагаться в столбце Y, потом в столбце Z и т. д. То есть одним макросом порядка 100 смет не обработать быстро. Поэтому нужен макрос, который бы мог бы определять вариант таблицы и обрабатывать ее нужным образом.

Так, в варианте 1 ключевая фраза "ВСЕГО затрат, руб." слово находится в столбце X. Соответственно должен быть запущен вариант Sub YxAD() для удаления столбцов Y:AD, N:V, H:K, B:F . Однако, если для обработки попалась таблица, которая структурно отличается — ключевая фраза не расположена в столбце X, то эти операции по удалению столбцов не выполняется.

Тогда для VBA предлагается проанализировать другой столбец Y на наличие ключевой фразы. Если эта фраза будет в столбце идентифицирована, то тогда выполнятся алгоритмы  Sub ZxAD(): удаление столбцов Z:AD, N:X, H:K, B:F. Если же опять ключевое слово не обнаружено в нужном столбце, то тогда ничего не делается, а включается другой Sub и т.д.

[Дмитрий Щербаков(The_Prist)]

А есть какой-то признак, по которому удаляются столбцы Y:AD, N:V, H:K, B:F, кроме текста "ВСЕГО затрат, руб." в столбце X? Чтобы не искать этот текст и не отталкиваться от него, а удалять сразу те столбцы, которые не нужны?

[АП]

Надо использовать

Код: (vb)

Select Case y
     Case "Условие №1"
             Имя макроса
      Case "Условие №2"
                    ...........
 End Select

Это позволит легко  добавлять условия удаления столбцов.

[Никола]

А есть какой-то признак, по которому удаляются столбцы Y:AD, N:V, H:K, B:F, кроме текста "ВСЕГО затрат, руб." в столбце X? Чтобы не искать этот текст и не отталкиваться от него, а удалять сразу те столбцы, которые не нужны?

Ну, во всяком случае мне такого не удалось его обнаружить — со сметами весьма сложно в этом отношении. Вот приложу примеры. Из такого нагромождения данных нужно  извлечь всего чуть чуть: наименование работ, ед. изм., кол-во, затрат руб. Это мне удалось решить, но при возникновении вариаций макросы меняю вручную. А теперь хотелось бы найти более автоматизированное решение.

[АП]

А зачем удалять столбцы?
Этого не нужно. У Вас каждый раздел отделяется пустой строкой от Итога по разделу. Это позволяет определить диапазон.
Как только мы определили в каком столбце находится нужная информация забираем в массив диапазон ячеек этого столбца, а Итог раздела считаем в макросе. А затем из массива переносим куда угодно.
Еще в предлагаемой Вами  форме некоторые данные находятся в объединенных ячейках и Вы никогда не найдете эти данные из-за вариаций. Надо убрать объединение.

[RAN]

Один за всех

Код: (vb)

Sub qq()
    Dim r1 As Range, r2 As Range
    ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
    Set r1 = Cells.Find("Кол-во единиц", LookAt:=xlWhole)
    Set r2 = Cells.Find("ВСЕГО затрат, руб.", LookAt:=xlWhole)
    Union(Range("B:F"), r1.EntireColumn.Offset(, 1).Resize(, r2.Column - r1.Column - 1), r2.EntireColumn.Offset(, 1).Resize(, 15)).Delete
End Sub

[Никола]

А зачем удалять столбцы?

Это то, что наглядно, что получилось мне определить при использовании кнопки "запись макроса".

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

Извиняюсь, вначале обработки таблиц, чтобы избежать "пляски" цифр из-за наличия в некоторых ячейках действующих формул, я копирую всё и вставляю только значения:

Код: (vb)

    Cells.Select
    Range("A7").Activate
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Для дальнейшей работы разбиваю все ячейки:

Код: (vb)

    Cells.Select
    Selection.UnMerge

Вроде эта операция простейшая, поэтому я не стал никого безпокоить.

[Никола]

Один за всех

Спасибо за рабочую штучку. Как Range("B:F") работает — понятно. А вот как r1 и r2 действуют — слабовато.  Много в них добавочных элементов и что к чему в толк не могу взять.

[Дмитрий Щербаков(The_Prist)]

Тут надо уже начинать изучать VBA шире, чем по коду макрорекордера. F1 и поиск по Яндексу должны помочь в большинстве случаев.
Set r1 = Cells.Find - поиск ячейки с заданным текстом в ячейках листа
r1.Column - номер столбца найденной ячейки
Union - объединение нескольких диапазонов в один
Resize - изменение размера диапазона до заданных границ

[Никола]

Так вроде столбцы в итоге удаляются, тогда почему используется Union (объединение нескольких диапазонов в один)? И для чего нужно Resize (изменение размера диапазона до заданных границ)? Что это за диапазон и где поменялся его размер?

[Дмитрий Щербаков(The_Prist)]

Union - это тоже самое, что выделение столбцов через Ctrl. Если надо удалить несколько несмежных между собой столбцов - то без такого выделения не обойтись.
Resize - насколько видел Ваши сообщения, то Вы же не по одному столбцу за раз удаляете, а указываете "N:Y" и т.п. А Resize берет столбец N и изменяет его размеры до диапазона "N:Y".

Все вопросы от незнания элементарных азов, которым Вас здесь вряд ли кто будет учить. Если сложно постигать или нет желания/времени - используйте совет из сообщения 3 и используйте Select Case. Менее универсально, но хотя бы более понятно Вам.