Question

我正在尝试在D列和H列中找到一个字符串，如果它们符合某些条件，请插入字符串＆＃34;匹配＆＃34;在W列中。

例如，如果字符串＆＃34; Auditorium＆＃34;发生在D列和字符串＆＃34; INTERNAL＆＃34;发生在同一行的H列中，插入字符串＆＃34;匹配＆＃34;在W栏。

下面我的代码插入字符串＆＃34;匹配＆＃34;在W列中反对包含字符串＆＃34; INTERNAL＆＃34;的所有行与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

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

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

3 个答案: