如何通过Sheet2列D文本匹配Sheet1名称，为列E赋值（适配XL2010）

原有代码的核心逻辑错误：你使用Sheet2 D列的完整长文本作为搜索关键词，在Sheet1的名称列执行部分匹配，等价于查找是否有名称包含这个完整长文本，和你的需求（查找长文本中是否包含任意一个Sheet1的名称）完全相反，所以无法得到正确结果。

方案1：适配Excel 2010的公式方案 #

Sheet2 E2单元格输入如下数组公式，输入完成后按Ctrl+Shift+Enter三键组合回车生效，之后下拉填充到所有行即可：

=IFERROR(INDEX(Sheet1!C:C,MAX(IF(ISNUMBER(SEARCH(Sheet1!A$2:A$999,D2)),ROW(Sheet1!A$2:A$999),IF(ISNUMBER(SEARCH(Sheet1!B$2:B$999,D2)),ROW(Sheet1!B$2:B$999),0)))),"无匹配")

• 公式中的A$2:A$999、B$2:B$999请修改为你Sheet1 A、B列名称实际的行范围
• SEARCH函数不区分大小写，且支持特殊字符匹配，符合你的需求
• 因为你明确说明两列名称无重复、无交叉，所以不用担心多个匹配的冲突问题

方案2：修正后的VBA方案 #

优化了逻辑，提前把Sheet1的所有名称和对应Score存入字典，遍历Sheet2的时候直接匹配，运行效率更高：

Sub TextSearch()
    Dim oSht1 As Worksheet, oSht2 As Worksheet
    Dim lastRow1 As Long, lastRow2 As Long, i As Long
    Dim nameDict As Object
    Dim searchStr As String, key As Variant
    
    ' 初始化字典，存储名称和对应的Score
    Set nameDict = CreateObject("Scripting.Dictionary")
    Set oSht1 = ThisWorkbook.Sheets("Sheet1")
    Set oSht2 = ThisWorkbook.Sheets("Sheet2")
    
    ' 获取Sheet1的最大行，把A、B列的名称和对应Score存入字典
    lastRow1 = oSht1.Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To lastRow1
        ' A列名称对应C列Score
        If Not nameDict.Exists(oSht1.Cells(i, "A").Value) Then
            nameDict.Add oSht1.Cells(i, "A").Value, oSht1.Cells(i, "C").Value
        End If
        ' B列名称对应C列Score
        If Not nameDict.Exists(oSht1.Cells(i, "B").Value) Then
            nameDict.Add oSht1.Cells(i, "B").Value, oSht1.Cells(i, "C").Value
        End If
    Next i
    
    ' 遍历Sheet2 D列匹配
    lastRow2 = oSht2.Range("D" & Rows.Count).End(xlUp).Row
    For i = 2 To lastRow2
        searchStr = oSht2.Cells(i, "D").Value
        oSht2.Cells(i, "E").Value = "无匹配" ' 初始默认值
        If Len(searchStr) > 0 Then
            ' 遍历字典的所有key，检查是否是当前字符串的子串
            For Each key In nameDict.Keys
                If InStr(1, searchStr, key, vbTextCompare) > 0 Then ' 不区分大小写匹配
                    oSht2.Cells(i, "E").Value = nameDict(key)
                    Exit For ' 找到就退出，因为名称无重复
                End If
            Next key
        End If
    Next i
    
    Set nameDict = Nothing
    Set oSht1 = Nothing
    Set oSht2 = Nothing
End Sub

• 代码采用vbTextCompare参数实现不区分大小写匹配，如需区分大小写可改为vbBinaryCompare
• 支持带连字符、撇号的特殊字符匹配，无需额外处理

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