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

Question

我试图在D列和H列中找到一个字符串，如果它们符合某些条件，请在W列中插入字符串“Match”。

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

我的代码在列W中插入字符串“Match”，对着包含字符串“INTERNAL”的所有行，而不管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

你不需要内循环。 找到“ 礼堂 ”一词后，只需查看内部的同一行，如果找到则设置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

如果您的数据也有一个“标题”行，那么您可以省略End With之前的最后一个代码行