Excel VBA技术实现：检查单元格是否包含列表中至少一个匹配项

为什么你的CountIf尝试失败？ #

你用CountIf的方向搞反了：如果直接写CountIf(Sheet2.Range("A:A"), Sheet1.Cells(i,1).Value)，是找Sheet2里和Sheet1单元格完全匹配的项，但你要的是Sheet1单元格包含Sheet2里的任意项，得把通配符加在Sheet2的项两边，反过来匹配Sheet1的单元格内容。

实现思路与代码 #

方法一：用工作表函数快速判断（高效简洁） #

利用Sum+CountIf的数组形式，一次性统计Sheet2列表中被当前单元格包含的项数，只要大于0就标记"Yes"。这种方法不用嵌套循环，处理大量数据时速度更快。

Sub CheckContainsItem()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lastRow1 As Long, lastRow2 As Long
    Dim i As Long
    Dim matchCount As Long
    
    ' 定义工作表对象
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    
    ' 获取两表的最后一行（避免遍历整列浪费资源）
    lastRow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
    lastRow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row
    
    ' 遍历Sheet1的A列非空单元格
    For i = 1 To lastRow1
        ' 统计Sheet2中被当前单元格包含的项数（通配符*匹配任意字符）
        matchCount = WorksheetFunction.Sum(WorksheetFunction.CountIf(ws1.Cells(i, 1), "*" & ws2.Range("A1:A" & lastRow2) & "*"))
        
        ' 根据结果设置B列值
        If matchCount > 0 Then
            ws1.Cells(i, 2).Value = "Yes"
        Else
            ws1.Cells(i, 2).Value = "" ' 需求需要的话也可以改为"No"
        End If
    Next i
End Sub

方法二：纯VBA循环遍历（灵活可控） #

如果需要更精细的控制（比如区分大小写、自定义匹配规则），可以用InStr函数逐个检查Sheet2的列表项，找到匹配就立即跳出循环，减少不必要的遍历。

Sub CheckContainsItem_Loop()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lastRow1 As Long, lastRow2 As Long
    Dim i As Long, j As Long
    Dim isMatch As Boolean
    
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    
    lastRow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
    lastRow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row
    
    For i = 1 To lastRow1
        isMatch = False ' 初始化匹配状态
        ' 遍历Sheet2的列表项
        For j = 1 To lastRow2
            ' InStr返回匹配位置，>0表示包含；vbTextCompare不区分大小写，vbBinaryCompare区分
            If InStr(1, ws1.Cells(i, 1).Value, ws2.Cells(j, 1).Value, vbTextCompare) > 0 Then
                isMatch = True
                Exit For ' 找到匹配就跳出内层循环，提升效率
            End If
        Next j
        
        ' 设置B列值
        ws1.Cells(i, 2).Value = IIf(isMatch, "Yes", "")
    Next i
End Sub

注意事项 #

• 若需区分大小写，将方法二中的vbTextCompare替换为vbBinaryCompare即可。
• 可在方法二中添加判断，跳过Sheet2 A列的空单元格，避免无效检查。
• 两种方法都先获取了数据区域的最后一行，避免遍历整列，大幅提升大样本数据的处理速度。

内容的提问来源于stack exchange，提问作者Phil