Question

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

当前，我正在使用具有Select Case True函数的InStr结构来搜索与关键字（"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语句的Array进行比较。我认为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

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

2 个答案: