VBA实现拆分零件号并检查是否存在于最低库存清单(MSL)

需求说明 #

• 现有物料清单包含零件号（分号拼接的组合值）、描述、数量
• 需检查每个拆分后的零件号是否在最低库存清单（MSL）中：存在标记“N”，不存在标记“Y”
• 最终结果需保持原零件号的分号拼接格式

原代码问题 #

• myNumbs = Array("B" & x) 错误将单元格地址字符串存入数组，未获取单元格实际值
• 未遍历拆分后的单个零件号，直接用原拼接值判断
• 结果固定写入E2单元格，未对应到当前行的E列
• 使用CountIf检查数组时语法错误，CountIf仅支持单元格区域，无法直接操作数组

修正后的VBA代码 #

Sub Check_MSL()
    Dim mylastrow6 As Long
    Dim mslfile As String
    Dim mslsheet As Worksheet
    Dim mslvalues As Variant
    Dim x As Long, j As Long, i As Long
    Dim partArr() As String
    Dim resultArr() As String
    Dim isInMSL As Boolean
    
    ' 读取MSL文件零件号数据到数组
    mslfile = "H:\05-Planning Engineering\blablablaProcedure\MSL.xlsx"
    Workbooks.Open mslfile
    Set mslsheet = ActiveWorkbook.Sheets("OrderLines")
    mylastrow6 = mslsheet.Cells(mslsheet.Rows.Count, "A").End(xlUp).Row
    mslvalues = mslsheet.Range("A1:A" & mylastrow6).Value
    Workbooks("MSL.xlsx").Close SaveChanges:=False
    
    ' 遍历物料清单每行数据
    With ActiveSheet
        For x = 2 To .Cells(.Rows.Count, "D").End(xlUp).Row
            ' 拆分当前行的零件号组合值
            partArr = Split(.Cells(x, "B").Value, ";")
            ReDim resultArr(LBound(partArr) To UBound(partArr))
            
            ' 逐个检查拆分后的零件号
            For i = LBound(partArr) To UBound(partArr)
                isInMSL = False
                ' 在MSL数组中匹配零件号，Trim处理空格
                For j = LBound(mslvalues) To UBound(mslvalues)
                    If Trim(partArr(i)) = Trim(mslvalues(j, 1)) Then
                        isInMSL = True
                        Exit For
                    End If
                Next j
                ' 赋值检查结果
                resultArr(i) = IIf(isInMSL, "N", "Y")
            Next i
            
            ' 拼接结果并写入当前行E列
            .Cells(x, "E").Value = Join(resultArr, ";")
        Next x
    End With
End Sub

代码说明 #

• 先将MSL零件号读取到数组，提升批量查找效率
• 遍历物料清单每行，拆分B列的组合零件号
• 对每个拆分后的零件号，在MSL数组中逐一匹配（加入Trim处理首尾空格）
• 将单个零件的检查结果存入数组，最后拼接成原格式写入对应行的E列
• 使用With ActiveSheet简化代码，避免重复引用工作表对象

内容的提问来源于stack exchange，提问作者Mehmet Şeker