Excel VBA两列内容部分匹配实现及运行时错误91问题求助

• 运行时错误'91'的核心原因：你声明了Worksheet类型变量ws但未对其进行初始化赋值，变量处于空对象状态，调用其单元格属性时直接触发未设置对象的报错。你需要补充Set ws = ThisWorkbook.Worksheets("你的工作表名称")（替换为实际工作表名）或者Set ws = ActiveSheet指定操作的工作表。
• 逻辑缺陷：
  • 内层循环遍历所有匹配项时，即使已经找到匹配值依然会继续循环，后续的不匹配结果会把已经匹配到的正确值覆盖为#N/A，最终结果大概率都是错误的
  • 直接对单元格进行读写操作，3万行数据嵌套千次循环，会产生大量Excel IO交互，运行效率极低，甚至会触发程序卡顿无响应

建议把所有数据一次性读取到内存数组中处理，全部计算完成后再一次性写回工作表，运行效率会提升数十倍，参考代码如下：

Sub 关键词匹配()
    Dim ws As Worksheet
    Dim arrDesc, arrVendor, arrResult
    Dim i As Long, j As Long, matchFlag As Boolean
    
    ' 初始化工作表，替换为你实际的工作表名
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    ' 把两列数据全部读入数组，避免频繁读写单元格
    arrDesc = ws.Range("O2:O32609").Value ' 待匹配文本列
    arrVendor = ws.Range("AE2:AE1007").Value ' 关键词列
    ReDim arrResult(1 To UBound(arrDesc, 1), 1 To 1) ' 结果数组
    
    ' 遍历所有待匹配文本
    For i = 1 To UBound(arrDesc, 1)
        matchFlag = False
        ' 遍历关键词，找到匹配就跳出循环
        For j = 1 To UBound(arrVendor, 1)
            ' 跳过空的关键词单元格
            If Not IsEmpty(arrVendor(j, 1)) Then
                ' 最后一个参数vbTextCompare代表不区分大小写，需区分大小写可替换为vbBinaryCompare
                If InStr(1, arrDesc(i, 1), arrVendor(j, 1), vbTextCompare) > 0 Then
                    arrResult(i, 1) = arrVendor(j, 1)
                    matchFlag = True
                    Exit For ' 找到匹配就退出内层循环，节省运行时间
                End If
            End If
        Next j
        ' 无匹配时赋值#N/A
        If Not matchFlag Then arrResult(i, 1) = "#N/A"
    Next i
    
    ' 一次性把结果写回P列
    ws.Range("P2:P32609").Value = arrResult
End Sub

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