基于InStr的VBA物料库存迁移需求：处理非精确字符串匹配

需求背景 #

从事建筑行业，需通过VBA实现按物料类型跟踪供应商物料库存，并将库存数量在工作表间迁移。当前两张工作表的物料名称存在差异（例如我方表为「siding」，供应商表为「veriform siding」），现有代码仅支持精确字符串匹配，需优化为使用InStr函数识别包含关系，完成库存数量迁移。

原代码 #

Sub simple2()

Dim i As Integer

Dim u As Integer

yarray = Worksheets("Sheet1").Cells(14, 1).CurrentRegion

zarray = Worksheets("Walk").Cells(5, 1).CurrentRegion


    For d = 14 To UBound(yarray)
       Worksheets("Sheet1").Cells(d, 1).Value = Trim(Worksheets("Sheet1").Cells(d, 1).Value)
    Next
    

    For q = 5 To UBound(zarray)
       Worksheets("Walk").Cells(q, 1).Value = Trim(Worksheets("Walk").Cells(q, 1).Value)
    Next


For i = 14 To 30

If Worksheets("Sheet1").Cells(i, 3).Value >= 0 Then

    For u = 5 To 39
    
        If Worksheets("Walk").Cells(u, 1).Value = Worksheets("Sheet1").Cells(i, 1).Value Then
        
        Worksheets("Walk").Cells(u, 2) = Worksheets("Sheet1").Cells(i, 3).Value
        
        End If
        
     Next
    
End If

Next
End Sub

修改后的优化代码 #

Sub MigrateInventoryWithFuzzyMatch()
    Dim wsOur As Worksheet, wsVendor As Worksheet
    Dim ourData As Variant, vendorData As Variant
    Dim i As Long, u As Long
    Dim ourMat As String, vendorMat As String
    
    ' 定义工作表对象，提升代码可读性
    Set wsOur = ThisWorkbook.Worksheets("Sheet1")
    Set wsVendor = ThisWorkbook.Worksheets("Walk")
    
    ' 读取数据到数组，减少工作表交互次数，提升运行效率
    ourData = wsOur.Cells(14, 1).CurrentRegion.Value
    vendorData = wsVendor.Cells(5, 1).CurrentRegion.Value
    
    ' 批量清理物料名称的前后空格
    For i = LBound(ourData, 1) To UBound(ourData, 1)
        ourData(i, 1) = Trim(ourData(i, 1))
    Next i
    
    For u = LBound(vendorData, 1) To UBound(vendorData, 1)
        vendorData(u, 1) = Trim(vendorData(u, 1))
    Next u
    
    ' 模糊匹配并迁移库存数量
    For i = LBound(ourData, 1) To UBound(ourData, 1)
        ' 仅处理有效库存数量（>=0）
        If ourData(i, 3) >= 0 Then
            ourMat = ourData(i, 1)
            For u = LBound(vendorData, 1) To UBound(vendorData, 1)
                vendorMat = vendorData(u, 1)
                ' 使用InStr判断供应商物料名称是否包含我方物料关键词，不区分大小写
                If InStr(1, vendorMat, ourMat, vbTextCompare) > 0 Then
                    vendorData(u, 2) = ourData(i, 3)
                End If
            Next u
        End If
    Next i
    
    ' 将更新后的数组批量写回供应商工作表
    wsVendor.Cells(5, 1).Resize(UBound(vendorData, 1), UBound(vendorData, 2)).Value = vendorData
End Sub

关键优化说明 #

• 模糊匹配逻辑：用InStr(1, vendorMat, ourMat, vbTextCompare)判断供应商表物料名称是否包含我方表的物料关键词，vbTextCompare参数实现不区分大小写的匹配，适配更多名称差异场景。
• 数组优化：将工作表数据一次性读取到数组中处理，大幅减少与工作表的交互次数，提升代码运行效率。
• 动态范围：使用LBound和UBound基于数组的实际范围循环，替代原代码的固定行号，适配数据行数变化的情况。
• 可读性提升：定义明确的工作表对象和变量名，让代码逻辑更清晰，便于后续维护。

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