Способ удаления всего столбца в макросе Excel на основе значения заголовка столбца, содержащего некоторую строку

Question

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

Примечание. Если заголовок столбца появляется n раз, он должен найти и удалите n столбцов в макросе vb.

Допустим, у меня есть заголовок столбца с именем "COLUMN_6", который появляется два раза, затем мой код должен найти заголовок столбца, который содержит COLUMN_6, и он должен удалить их два столбца.

Я написал следующий код, и он работает частично.

Sub ClearSpecificColumns()

    Dim last_col As Long

    'get the last column
    last_col = Worksheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft).Column

     MsgBox ("222" & last_col)

    'iterate from 1 to last column
    For i = 1 To last_col

        If Cells(1, i).Value Like "COLUMN_6" Then

           Columns(i).Delete

        End If

    Next

End Sub

Проблемы:

Приведенный выше код находит и удаляет ТОЛЬКО ОДИН РАЗ (только при первом появлении) всего столбца с COLUMN_6. Предполагается удалить оба столбца.

, почему в этом случае НЕ выполняется итерация во второй раз, чтобы удалить второе появление COLUMN_6.

Любой другой простой и быстрый способ сделать это?

Answer 1

Вы можете взять столбцы дубликатов в массив, затем создать один диапазон со всеми столбцами с дубликатами и стереть их сразу:

Dim rng As Range
Dim MyHeaders As Range
Dim ToDelete() As Variant
Dim i As Long

Dim last_col As Long

'get the last column
last_col = Worksheets("Sheet1").Cells(1, Worksheets("Sheet1").Columns.Count).End(xlToLeft).Column

Set MyHeaders = Worksheets("Sheet1").Range(Cells(1, 1), Cells(1, last_col))

ReDim ToDelete(MyHeaders.Count)

i = 0
For Each rng In MyHeaders
    If Application.WorksheetFunction.CountIf(MyHeaders, rng.Value) > 1 Then
        'it's duplicated. We store the column number
        ToDelete(i) = rng.Column
    Else
        'it's unique, we store a 0
        ToDelete(i) = 0
    End If
    i = i + 1
Next rng

For i = 0 To UBound(ToDelete) Step 1
    If ToDelete(i) <> 0 Then
        If rng Is Nothing Then
            Set rng = MyHeaders.Cells(1, ToDelete(i)).EntireColumn
        Else
            Set rng = Union(rng, MyHeaders.Cells(1, ToDelete(i)).EntireColumn)
        End If
    End If
Next i

Erase ToDelete
rng.Delete xlShiftToLeft

Set rng = Nothing
Set MyHeaders = Nothing