如何使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