From dd931eba534ea59508969f2b00bad2d2400c5eea Mon Sep 17 00:00:00 2001 From: Misaka_Company Date: Fri, 27 Feb 2026 13:07:29 +0800 Subject: [PATCH] fix: implement dual collection system for component materials and fix inventory comparison - Add outRawMaterials parameter to ProcessSingleModel and MatchAllMaterialTypesWithValidation - Implement dual collection system: filtered materials (allMaterials) and raw materials (outRawMaterials) - Filter out component markers when isStockSufficient=False for BOM extraction results - Preserve component markers in raw materials for inventory comparison worksheet - Add productionOrderNo field to rawMaterials for proper order tracking - Fix sequence number generation in WriteInventoryComparisonResults (start from 10) - Adapt data access from array format to dictionary format in WriteInventoryComparisonResults - Add debug output for troubleshooting order number propagation This ensures: - BOM extraction results show actual materials used (component or sub-components) - Inventory comparison worksheet always shows component information regardless of inventory status - Proper order number mapping and sequence number generation Co-Authored-By: Claude Sonnet 4.5 --- VBA_BOMConverter/Modules/M09_BOMExtractor.bas | 226 +++++++++++------- 1 file changed, 136 insertions(+), 90 deletions(-) diff --git a/VBA_BOMConverter/Modules/M09_BOMExtractor.bas b/VBA_BOMConverter/Modules/M09_BOMExtractor.bas index 582e5a8..08d3cd0 100644 --- a/VBA_BOMConverter/Modules/M09_BOMExtractor.bas +++ b/VBA_BOMConverter/Modules/M09_BOMExtractor.bas @@ -117,6 +117,10 @@ Public Function BOMExtraction() As String Dim allResults As Collection Set allResults = New Collection + ' 未过滤的物料集合（用于库存比对工作表） + Dim allRawMaterials As Collection + Set allRawMaterials = New Collection + ' 产品编码映射（用于BIP上传工作表生成） Dim productCodeMap As Object Set productCodeMap = CreateObject("Scripting.Dictionary") @@ -151,9 +155,16 @@ Public Function BOMExtraction() As String End If Dim modelResults As Collection - Set modelResults = ProcessSingleModel(modelString, g_BOMWorkbook, g_Logger, productionOrderNo, orderQty) + Dim rawMaterials As Collection + Set modelResults = ProcessSingleModel(modelString, g_BOMWorkbook, g_Logger, productionOrderNo, orderQty, rawMaterials) - ' 合并结果 + ' 收集未过滤的物料（用于库存比对） + Dim rawMat As Variant + For Each rawMat In rawMaterials + allRawMaterials.Add rawMat + Next rawMat + + ' 合并已过滤的结果（用于BOM提取结果和BIP上传） Dim result As Variant For Each result In modelResults allResults.Add result @@ -180,8 +191,20 @@ Public Function BOMExtraction() As String ' 步骤5.6: 生成库存比对工作表 Application.StatusBar = "正在生成库存比对数据..." + ' 筛选部件类型的物料（从未过滤的物料集合中） + ' 注意：rawMaterials 已经包含 productionOrderNo 字段 + Dim componentMaterials As Collection + Set componentMaterials = New Collection + + Dim rawMat As Variant + For Each rawMat In allRawMaterials + If rawMat("materialType") = "部件" Then + componentMaterials.Add rawMat + End If + Next rawMat + Dim wsInventoryCompare As Worksheet - Set wsInventoryCompare = WriteInventoryComparisonResults(allResults, inputModels) + Set wsInventoryCompare = WriteInventoryComparisonResults(componentMaterials, inputModels) If wsInventoryCompare Is Nothing Then BOMExtraction = "错误：无法生成库存比对工作表。" @@ -367,7 +390,8 @@ Private Function ProcessSingleModel( _ ByVal bomWb As Workbook, _ ByVal logger As clsErrorLogger, _ ByVal productionOrderNo As String, _ - ByVal orderQty As Long _ + ByVal orderQty As Long, _ + ByRef outRawMaterials As Collection _ ) As Collection On Error GoTo ErrorHandler @@ -382,6 +406,9 @@ Private Function ProcessSingleModel( _ If params.count = 0 Then ' 解析失败，添加错误行 results.Add GenerateErrorRow(modelString, "型号解析失败：型号格式不正确或缺少必要字段", productionOrderNo, True) + + ' 设置输出参数 + Set outRawMaterials = New Collection Set ProcessSingleModel = results Exit Function End If @@ -389,7 +416,23 @@ Private Function ProcessSingleModel( _ ' 步骤2: 匹配所有物料类型（两阶段） Dim allMaterials As Collection Dim validation As Object - Set allMaterials = MatchAllMaterialTypesWithValidation(params, bomWb, logger, orderQty, productionOrderNo, validation) + Dim rawMaterials As Collection + Set allMaterials = MatchAllMaterialTypesWithValidation(params, bomWb, logger, orderQty, productionOrderNo, validation, rawMaterials) + + ' 为原始物料添加订单号信息（用于库存比对工作表） + Debug.Print "=== ProcessSingleModel: 添加订单号到rawMaterials ===" + Debug.Print " productionOrderNo = [" & productionOrderNo & "]" + Debug.Print " rawMaterials.count = " & rawMaterials.count + + Dim rawMat As Variant + For Each rawMat In rawMaterials + If Not rawMat.Exists("productionOrderNo") Then + rawMat("productionOrderNo") = productionOrderNo + Debug.Print " 添加订单号 [" & productionOrderNo & "] 到物料 [" & rawMat("materialCode") & "]" + Else + Debug.Print " 物料 [" & rawMat("materialCode") & "] 已有订单号 [" & rawMat("productionOrderNo") & "]" + End If + Next rawMat ' 步骤3: 生成输出行 Dim remarks As String @@ -416,6 +459,8 @@ Private Function ProcessSingleModel( _ results.Add GenerateErrorRow(modelString, "未匹配到任何物料", productionOrderNo, True) End If + ' 设置输出参数 + Set outRawMaterials = rawMaterials Set ProcessSingleModel = results Exit Function @@ -457,7 +502,8 @@ Private Function MatchAllMaterialTypesWithValidation( _ ByVal logger As clsErrorLogger, _ ByVal orderQty As Long, _ ByVal productionOrderNo As String, _ - ByRef outValidation As Object _ + ByRef outValidation As Object, _ + ByRef outRawMaterials As Collection _ ) As Collection On Error GoTo ErrorHandler @@ -572,6 +618,9 @@ Private Function MatchAllMaterialTypesWithValidation( _ Dim allMaterials As Collection Set allMaterials = New Collection + ' 初始化未过滤集合（用于库存比对工作表） + Set outRawMaterials = New Collection + If validationResult("valid") Then ' 验证通过，收集所有物料 Dim resultKey As Variant @@ -581,7 +630,22 @@ Private Function MatchAllMaterialTypesWithValidation( _ Dim mat As Variant For Each mat In result("materials") - allMaterials.Add mat + ' 1. 添加到未过滤集合（所有物料，用于库存比对） + outRawMaterials.Add mat + + ' 2. 添加到已过滤集合（排除库存不足的部件标记） + Dim shouldExclude As Boolean + shouldExclude = False + + If mat.Exists("isStockSufficient") Then + If mat("isStockSufficient") = False And mat("materialType") = "部件" Then + shouldExclude = True + End If + End If + + If Not shouldExclude Then + allMaterials.Add mat + End If Next mat Next resultKey Else @@ -593,7 +657,22 @@ Private Function MatchAllMaterialTypesWithValidation( _ Dim mat2 As Variant For Each mat2 In result2("materials") - allMaterials.Add mat2 + ' 1. 添加到未过滤集合（所有物料，用于库存比对） + outRawMaterials.Add mat2 + + ' 2. 添加到已过滤集合（排除库存不足的部件标记） + Dim shouldExclude As Boolean + shouldExclude = False + + If mat2.Exists("isStockSufficient") Then + If mat2("isStockSufficient") = False And mat2("materialType") = "部件" Then + shouldExclude = True + End If + End If + + If Not shouldExclude Then + allMaterials.Add mat2 + End If Next mat2 Next resultKey2 End If @@ -1408,7 +1487,7 @@ End Function ' 7: 库存充足（"是"/"否"） ' ------------------------------------------------------------------------------ Private Function WriteInventoryComparisonResults( _ - ByVal results As Collection, _ + ByVal componentMaterials As Collection, _ ByVal inputModels As Variant _ ) As Worksheet On Error GoTo ErrorHandler @@ -1416,20 +1495,14 @@ Private Function WriteInventoryComparisonResults( _ Dim ws As Worksheet Dim headers As Variant Dim c As Long - Dim modelToOrderMap As Object Dim i As Long Dim j As Long - Dim result As Variant - Dim OrderNo As String - Dim modelStr As String - Dim componentResults As Collection - Dim materialType As String + Dim matInfo As Object Dim outputArr() As Variant Dim baseSeqNum As Long Dim materialSeqNum As Long Dim currentOrderNo As String Dim prevOrderNo As String - Dim resultOrderNo As String Dim finalSeqNum As Long Dim orderQty As Long Dim materialCode As String @@ -1467,80 +1540,64 @@ Private Function WriteInventoryComparisonResults( _ .HorizontalAlignment = xlCenter End With - ' ======================================== - ' 步骤1: 构建产品型号 → 生产订单号的映射 - ' ======================================== - ' 在BOM提取结果中，result(1)（生产订单号）仅第一行有值， - ' 但result(2)（原始产品型号）每行都有值 - ' 因此需要建立映射：产品型号 → 生产订单号 - - Set modelToOrderMap = CreateObject("Scripting.Dictionary") - - For i = 1 To results.count - result = results(i) - - OrderNo = CStr(result(1)) ' 第1列：生产订单号 - modelStr = CStr(result(2)) ' 第2列：原始产品型号 - - ' 仅当订单号不为空时，添加映射 - If Len(Trim(OrderNo)) > 0 And Len(Trim(modelStr)) > 0 Then - If Not modelToOrderMap.Exists(modelStr) Then - modelToOrderMap.Add modelStr, OrderNo - End If - End If - Next i - - ' ======================================== - ' 步骤2: 筛选"部件"类型物料 - ' ======================================== - Set componentResults = New Collection - - For i = 1 To results.count - result = results(i) - - ' 第9列是物料类型 - materialType = CStr(result(9)) - - ' 仅处理"部件"类型 - If materialType = "部件" Then - componentResults.Add result - End If - Next i - ' 写入数据 - If componentResults.count > 0 Then + If componentMaterials.count > 0 Then ' 先设置物料编码列（第3列，C列）为文本格式 - ws.Range("C2:C" & (componentResults.count + 1)).NumberFormat = "@" + ws.Range("C2:C" & (componentMaterials.count + 1)).NumberFormat = "@" ' 准备输出数组 - ReDim outputArr(1 To componentResults.count, 1 To 7) + ReDim outputArr(1 To componentMaterials.count, 1 To 7) ' 序号生成变量 baseSeqNum = 0 materialSeqNum = 0 currentOrderNo = "" prevOrderNo = "" + Dim isFirstOrder As Boolean + isFirstOrder = True + + ' 按订单号分组（先排序，确保同一订单的物料连续） + ' 由于VBA中没有现成的排序函数，我们需要手动处理 + ' 这里假设componentMaterials已经按订单号分组（主循环中按顺序添加） ' ======================================== ' 步骤3: 写入库存比对数据 ' ======================================== - For i = 1 To componentResults.count - result = componentResults(i) + Debug.Print "=== WriteInventoryComparisonResults: 开始写入库存比对数据 ===" + Debug.Print " componentMaterials.count = " & componentMaterials.count - ' 【关键修复】从映射表中获取订单号 - modelStr = CStr(result(2)) ' 第2列：原始产品型号 + For i = 1 To componentMaterials.count + Set matInfo = componentMaterials(i) - If modelToOrderMap.Exists(modelStr) Then - resultOrderNo = CStr(modelToOrderMap(modelStr)) + Debug.Print " 物料 [" & i & "]: 编码=[" & matInfo("materialCode") & "], 订单号=[" & matInfo("productionOrderNo") & "]" + + ' 获取物料编码和名称 + materialCode = CStr(matInfo("materialCode")) + materialName = CStr(matInfo("materialName")) + + ' 获取BOM数量 + If IsNumeric(matInfo("materialQty")) Then + bomQty = CLng(matInfo("materialQty")) Else - resultOrderNo = "" + bomQty = 1 End If + ' 获取订单号 + currentOrderNo = CStr(matInfo("productionOrderNo")) + ' 检测新订单 - If resultOrderNo <> prevOrderNo And Len(Trim(resultOrderNo)) > 0 Then - prevOrderNo = resultOrderNo - currentOrderNo = resultOrderNo - baseSeqNum = baseSeqNum + 10 + If currentOrderNo <> prevOrderNo And Len(Trim(currentOrderNo)) > 0 Then + prevOrderNo = currentOrderNo + + If isFirstOrder Then + ' 第一个订单，基础序号从10开始 + baseSeqNum = 10 + isFirstOrder = False + Else + ' 后续订单，基础序号递增10 + baseSeqNum = baseSeqNum + 10 + End If + materialSeqNum = 0 End If @@ -1558,17 +1615,6 @@ Private Function WriteInventoryComparisonResults( _ End If Next j - ' 提取物料信息 - materialCode = CStr(result(11)) ' 第11列：物料编码 - materialName = CStr(result(10)) ' 第10列：物料名称 - - ' 第12列：BOM库基础数量 - If IsNumeric(result(12)) Then - bomQty = CLng(result(12)) - Else - bomQty = 1 - End If - ' 获取库存信息 Set invInfo = M08_ComponentProcessor.GetComponentInventoryInfo( _ materialCode, bomQty, orderQty) @@ -1582,25 +1628,25 @@ Private Function WriteInventoryComparisonResults( _ ' 填充输出数组 outputArr(i, 1) = finalSeqNum ' 序号 - outputArr(i, 2) = currentOrderNo ' 【关键修复】生产订单号 - outputArr(i, 3) = materialCode ' 物料编码 - outputArr(i, 4) = materialName ' 物料名称 - outputArr(i, 5) = requiredQty ' 所需数量 - outputArr(i, 6) = stockQty ' 库存数量 - outputArr(i, 7) = isSufficientStr ' 库存充足 + outputArr(i, 2) = currentOrderNo ' 生产订单号 + outputArr(i, 3) = materialCode ' 物料编码 + outputArr(i, 4) = materialName ' 物料名称 + outputArr(i, 5) = requiredQty ' 所需数量 + outputArr(i, 6) = stockQty ' 库存数量 + outputArr(i, 7) = isSufficientStr ' 库存充足 Next i ' 批量写入数据 - ws.Range("A2").Resize(componentResults.count, 7).Value = outputArr + ws.Range("A2").Resize(componentMaterials.count, 7).Value = outputArr ' 格式化数据区域 - With ws.Range("A2:G" & (componentResults.count + 1)) + With ws.Range("A2:G" & (componentMaterials.count + 1)) .Borders.LineStyle = xlContinuous .Borders.Weight = xlThin End With ' 根据库存状态设置背景色 - For i = 1 To componentResults.count + For i = 1 To componentMaterials.count suffStatus = CStr(outputArr(i, 7)) If suffStatus = "否" Then