比较两列中的唯一字符串 Excel VBA

Question

我正在尝试在 D 列和 H 列中查找字符串，如果它们符合特定条件，则在 W 列中插入字符串 "Match"。

例如，如果字符串"Auditorium"出现在D列，字符串"INTERNAL"出现在同一行的H列，则在W列插入字符串"Match"。

我下面的代码针对包含字符串 "INTERNAL" 的所有行在 W 列中插入字符串 "Match"，而不管 D 列中的字符串如何！

如有任何建议，我们将不胜感激！

行 | D 列 | H 栏 | W列

1 |礼堂 |马丁（内部）|匹配

2 |礼堂 |约翰 |

3 |剧院 |爱德华（内部）|匹配

4 |剧院 |乔治 |匹配

Dim celA
Dim celB
    For Each celA In Range("D1:D50")
        For Each celB In Range("H1:H50")
                If InStr(1, celA.Value, "Auditorium") <> 0 And InStr(1, celB.Value, "INTERNAL") <> 0 Then celB.Offset(0, 10).Value = "Match"
        Next celB
    Next celA

Answer 1

您不需要内部循环。找到单词 auditorium 后，只需在同一行中查找 internal，如果找到，则在 W 列中设置值。

Dim celD
For Each celD In Range("D1:D50")
    If cbool(InStr(1, lcase(celD.Value), "auditorium")) then
        If cbool(InStr(1, lcase(celD.offset(0, 4).Value), "internal")) then
            celD.offset(0, 19) = "Match"
        end if
    end if
Next celD

Answer 2

已发布的其他变体

Dim celD As Range, SearchKey$
SearchKey = "*auditorium*internal*"
For Each celD In [D1:D50]
    If LCase(celD.Text & celD.Offset(, 4).Text) Like LCase(SearchKey) Then '.text instead of value|value2 is used to convert #errors into string (e.g. #N/A)
        celD.Offset(, 19) = "Match"
    End If
Next celD

Answer 3

您也可以使用 AutoFilter() 来做到这一点，从而避免循环（评论中的解释）：

With Range("H1", Cells(Rows.Count, "D").End(xlUp)) 'reference columns "H:D" range from row 1 down to column D last not empty row
    .AutoFilter Field:=1, Criteria1:="Auditorium" 'filter referenced range on its first column (i.e. column "D") with value "Auditorium
    .AutoFilter Field:=5, Criteria1:="*INTERNAL*" 'filter referenced range on its fifth column (i.e. column "H") with value containing "INTERNAL"
    If Application.WorksheetFunction.Subtotal(103, .Columns(1)) > 1 Then .Resize(, 1).Offset(, 19).SpecialCells(xlCellTypeVisible).Value = "MATCH" 'if any "data" (i.e. from 2nd row downwards) rows matching criteria then write "MATCH" in corresponding rows of 19th column of referenced range (i.e. column "W")
    If .Cells(1, 1).Value = "Auditorium" And InStr(.Cells(1, 5), "INTERNAL") > 0 Then .Cells(1, 20).Value = "MATCH" 'check first ("Headers") rows too
End With
ActiveSheet.AutoFilterMode = False 'remove filters

如果您的数据也有 "header" 行，那么您可以省略 End With

之前的最后一行代码

比较两列中的唯一字符串 Excel VBA

Comparing unique strings in two columns Excel VBA

excel

vba

string-comparison

multiple-columns