如何删除标题中没有指定单词的所有列？答案

【问题标题】：How can I delete all columns that do not have specified words in header?如何删除标题中没有指定单词的所有列？
【发布时间】：2019-12-14 06:52:00
【问题描述】：

我正在尝试通过仅显示必要的列来清理我的工作表。但是，由于我不知道工作表上可能还有哪些其他列，所以我试图删除所有标题中没有指定单词的列。例如，我需要显示“First Name”、“Last Name”和“Phone Number”，并删除所有其他列。

我目前正在使用下面的代码来执行此操作。问题是这样的 - 有时，在数据源中，“电话号码”的列名称被指定为“手机”。在这种情况下，我想将“电话”一词与列标题匹配并保留它，无论它是“电话号码”还是“手机”。现在，如果标题没有说“电话号码”，它就会被删除。

Mylist = Array("First Name", "Last Name", "Phone Number") 

LC = Cells(1, Columns.Count).End(xlToLeft).Column

For mycol = LC To 1 Step -1
    x = ""
    On Error Resume Next
    x = WorksheetFunction.Match(Cells(1, mycol), Mylist, 0)
    If Not IsNumeric(x) Then Columns(mycol).EntireColumn.Delete
Next mycol

如何将列标题与包含的单词而不是确切的名称相匹配？

【问题讨论】：

你需要遍历MyList

标签： excel vba macos columnheader

【解决方案1】：

由于目标是获得部分匹配，因此建议使用Range.Find method (Excel) 而不是WorksheetFunction.Match。

数组列表应该只有我们需要找到的关键字，即Phone而不是Phone Number等。

此解决方案使用Range.Find 方法创建一个包含所有所需字段的Target 范围，然后删除所有不在Target 范围内的列。

Sub Range_Delete_Unwanted_Fields()
Dim aList As Variant
aList = Array("Missing1", "Name", "Missing2", "Phone")
Dim ws As Worksheet
Dim rSrc As Range, rTrg As Range, rCll As Range
Dim vItem As Variant, sAdrs As String

    Set ws = ThisWorkbook.Worksheets("DATA")

    Rem Set Source Range (Header)
    With ws
        Set rSrc = .Cells(1).Resize(1, .Cells(1, .Columns.Count).End(xlToLeft).Column)
        rSrc.EntireColumn.Hidden = False
    End With

    Rem Set Target Range (Fields in Array List)
    For Each vItem In aList
        With rSrc

            Rem Clear 1st Found Cell Address
            sAdrs = vbNullString

            Rem Set 1st Found Cell
            Set rCll = .Cells.Find( _
                What:=vItem, After:=.Cells(.Cells.Count), _
                LookIn:=xlFormulas, LookAt:=xlPart, _
                SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)

            Rem Validate 1st Found Cell
            If Not (rCll Is Nothing) Then

                Rem Get 1st Found Cell Address
                sAdrs = rCll.Address

                Rem Add Found Cell To Target Range
                If rTrg Is Nothing Then
                    Set rTrg = rCll
                Else
                    Set rTrg = Union(rTrg, rCll)
                End If

                Rem Find Other Cells
                Do
                    Set rCll = .Cells.FindNext(After:=rCll)

                    Rem Validate Next Cell against 1st Cell
                    If rCll.Address = sAdrs Then Exit Do

                    Rem Add Next Cell To Target Range
                    Set rTrg = Union(rTrg, rCll)

                Loop Until rCll.Address = sAdrs

    End If: End With: Next

    Rem Validate Target Range
    If Not rTrg Is Nothing Then
        Rem Delete Columns Not in Target Range Only if Headers were found!
        rTrg.EntireColumn.Hidden = True
        rSrc.SpecialCells(xlCellTypeVisible).EntireColumn.Delete
        rTrg.EntireColumn.Hidden = False
    End If

    Application.Goto ws.Cells(1), 1

    End Sub

【讨论】：