如何删除 header 中所有没有指定单词的列？

Question

我试图通过只显示必要的列来整理我的工作sheet。但是，由于我不知道 sheet 上可能还有哪些其他列，我试图删除所有在 header 中没有指定单词的列。例如，我需要显示 'First Name'、'Last Name' 和 'Phone Number'，并删除所有其他列。

我目前正在使用下面的代码来做到这一点。问题是这样的 - 有时，在数据源中，'Phone Number' 的列名称被指定为 'Cell Phone'。在这种情况下，我想将单词 'phone' 与列 header 匹配并保留它，无论它是 'Phone Number' 还是 'Cell Phone'。现在，如果 header 没有说 '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

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

Answer 1

由于objective是获取部分匹配所以建议使用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

如何删除 header 中所有没有指定单词的列？

How can I delete all columns that do not have specified words in header?

excel

vba

macos

columnheader