如何使Excel VBA宏刪除帶有許多不同字符串作為標題的列？

Question

因此，我要導入一個大型電子表格，該電子表格的頂部應有20至40個標題，而我想自動（快速）刪除所有具有特定標題的列。 我有一個當前的代碼可以正常工作，但是它多次遍歷所有列，每次都查找不同的字符串。 我希望它循環一次並刪除具有要刪除的任何字符串的任何列。

這是我的代碼的一部分，可以更好地進行解釋：

Sub SetUpICTRP()

‘MsgBox “Excel will refresh when macro is complete”
Application.ScreenUpdating = False

Dim c As Range
Dim SrchRng As Range
Dim lastColumn As Long

lastColumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Set SrchRng = ActiveSheet.Range("A1", Cells(1, lastColumn))   

Do
    Set c = SrchRng.Find("column", LookIn:=xlValues)
    If Not c Is Nothing Then c.EntireColumn.Delete
Loop While Not c Is Nothing
Do
    Set c = SrchRng.Find("Erroneous", LookIn:=xlValues)
    If Not c Is Nothing Then c.EntireColumn.Delete
Loop While Not c Is Nothing
Do
    Set c = SrchRng.Find("Unnecessary", LookIn:=xlValues)
    If Not c Is Nothing Then c.EntireColumn.Delete
Loop While Not c Is Nothing
Do
    Set c = SrchRng.Find("Not_", LookIn:=xlValues)
    If Not c Is Nothing Then c.EntireColumn.Delete
Loop While Not c Is Nothing
Application.ScreenUpdating = True
End Sub

因此，當前它將刪除帶有標題的所有列，這些標題包含短語“ column”，“ Er錯誤”，“不必要”和“ Not_”。 我真正需要的是它能夠查找和刪除“ column218”，“ columnadfe”，“ column099”，“ Not_needed”之類的列，而無需多次運行單獨的循環。 我認為解決方案在於以某種方式創建字符串數組，然后遍歷每一列的每個字符串，但是我對VBA還是很陌生，似乎無法實現這一目標。 任何幫助將是巨大的！

Answer 1

您可以遍歷並找到單詞，然后使用Union()方法將標題整理到單個Range對象中，然后使用.EntireColumn方法刪除與非連續單元格相關的列。

---

Sub SO()

Dim findValue As Variant, findRange As Excel.Range, deleteRange As Excel.Range
Dim findAddress As String

For Each findValue In Array("column", "Erroneous", "Unnecessary", "Not_", _
    "Other1", "Other2", "Other3", "etc...")

    Set findRange = Rows(1).EntireRow.Find(what:=findValue, LookIn:=xlValues, lookat:=xlPart)

    If Not findRange Is Nothing Then
        findAddress = findRange.Address
        Do
            If Not deleteRange Is Nothing Then
                Set deleteRange = Union(deleteRange, findRange)
            Else
                Set deleteRange = findRange
            End If

            Set findRange = Rows(1).EntireRow.FindNext(findRange)
        Loop Until findRange Is Nothing Or findRange.Address = findAddress

    Set findRange = Nothing
    End If

Next findValue

If deleteRange Is Nothing Then
    MsgBox "No columns were found for deletion!"
Else
    deleteRange.EntireColumn.Delete
End If

End Sub

或按照您的原始設置，您可以使用以下方法：

Sub SO()

Dim c As Range, findValue As Variant

For Each findValue In Array("column", "Erroneous", "Unnecessary", "Not_", _
    "Other1", "Other2", "Other3", "etc...")
    Do
        Set c = Rows(1).EntireRow.Find(findValue, LookIn:=xlValues)
        If Not c Is Nothing Then c.EntireColumn.Delete
    Loop While Not c Is Nothing

Next findValue

End Sub