在列中搜索数百个关键字，并在偏移单元格中输出关键字

Question

关于这个问题：Find value in column and output in adjacent cell

目前，我正在使用带有InStr 函数的Select Case True 结构来搜索与关键字匹配的列中的单元格（"Costco", etc），然后在偏移单元格中输出这些关键字。此外，没有这些关键字的单元格会突出显示，并且搜索不区分大小写。见以下代码：

Sub FindAndOutput()

Dim Col As Range
Dim FirstRow As Range
Dim rng As Range
Dim WorkRng As Range

Set Col = Application.InputBox("Select Column", "Obtain Object Range", Type:=8)
Set FirstRow = Application.InputBox("Select FIrst Row", "Obtain Object Range", Type:=8)

Set WorkRng = Range(Cells(FirstRow.Row, Col.Column), Cells(Cells(Rows.Count, Col.Column).End(xlUp).Row, Col.Column))

For Each rng In WorkRng

Select Case True

Case InStr(1, rng.Value, "Costco", 1) > 0
Cells(rng.Row, rng.Column + 1) = "Costco"

'Other Keywords

Case Else
Cells(rng.Row, rng.Column).Interior.Color = 65535

End Select
Next
End Sub

我一直想知道哪种 VBA 方法最适合此过程（执行时间最短，编写的代码更少），而不是搜索几个关键字，而是有数百个关键字。

我应该使用array 吗？如果是这样，我是否正确编写了下面的代码？

Sub FindVendorAndOutputVendor()

Dim Col As Range
Dim FirstRow As Range
Dim rng As Range
Dim WorkRng As Range
Dim Vendor As Variant

Set Vendor = Array("Costco", "Walmart") 'Add more vendors

Set Col = Application.InputBox("Select Column", "Obtain Object Range", Type:=8)
Set FirstRow = Application.InputBox("Select FIrst Row", "Obtain Object Range", Type:=8)

Set WorkRng = Range(Cells(FirstRow.Row, Col.Column), Cells(Cells(Rows.Count, Col.Column).End(xlUp).Row, Col.Column))

For Each rng In WorkRng

    If InStr(1, rng.Value, Vendor, vbTextCompare) > 0 Then
    Cells(rng.Row, rng.Column + 1) = Vendor

    Else
    Cells(rng.Row, rng.Column).Interior.Color = 65535

        End If

            Next
End Sub

我应该使用字典吗？如果是这样，有人可以指导我吗？ 我应该坚持Select Case True 结构吗？

最后，如果我提出的部分解决方案都不是最好的，那么什么是最好的？

Answer 1

我会使用一个带有另一个循环的数组和一个 IF 语句来进行比较。我认为Select Case 方法将是硬编码的，我总是倾向于避免这种情况。遵循@Marcucciboy 的观点......这是如何做到的：

Dim Rng As Range, WorkRng As Range
Dim Vendor As Variant
Dim vData 'As Variant
Dim vDataVendor 'As Variant
Dim rngHighlight As Range
Dim i As Long, j As Long

    Vendor = Array("Costco", "Walmart")
    vData = WorkRng.Value2
    vDataVendor = WorkRng.Offset(0, 1).Value2

    For i = LBound(vData) To UBound(vData)
        ' Loop through, looking for a Vendor that matches
        For j = LBound(Vendor) To UBound(Vendor)
            If InStr(1, vData(i, 1), Vendor(j), vbTextCompare) > 0 Then
                vDataVendor(i, 1) = Vendor(j)
                ' Exit the loop, limiting it to only one vendor
                Exit For
            End If
        Next
        ' If None of the Vendors ware found, then add the cell to the Highlight range.
        If j > UBound(Vendor) Then
            If rngHighlight Is Nothing Then
                Set rngHighlight = WorkRng(i)
            Else
                Set rngHighlight = Union(rngHighlight, WorkRng(i))
            End If
        End If
    Next
    WorkRng.Offset(0, 1).Resize(UBound(vData) - LBound(vData) + 1, 1) = vDataVendor
    If Not rngHighlight Is Nothing Then rngHighlight.Interior.Color = 65535

请注意我如何设置一系列单元格以突出显示，而不是在找到它们时逐个进行。这也将加快例程，因为与工作表/单元格的任何/所有交互都很慢。你很难找到比这更快的东西。

Answer 2

您可以使用 VBA，但我想知道直接在 Excel 中使用公式是否更容易...然后您可以使用条件格式来突出显示您的单元格。见：Excel: Search for a list of strings within a particular string using array formulas?

如果商店名称列与您正在搜索的商店名称列表完全匹配，那么您可以在 Excel 中使用更简单的 VLookup() 函数。

至于如原始问题中所述在 VBA 中运行此过程，您还可以使用集合对象。我发现这比数组更具可读性和易于理解，但这更多是个人喜好。

Public Sub Example()

    Const strSearch As String = "The Costco Store"
    Dim colWords As New Collection
    Dim varWord As Variant

    With colWords
        ' Load words (You could also load these from a spreadsheet)
        .Add "Walmart"
        .Add "Costco"
        .Add "Target"

        ' Loop through words, searching for match
        For Each varWord In colWords
            If strSearch Like "*" & varWord & "*" Then
                ' Found match
                ' Highlight cell, display text, etc...
                Debug.Print varWord
                ' Exit the loop, since we already found a match.
                Exit For
            End If
        Next varWord
    End With

End Sub