fix: implement dual collection system for component materials and fix inventory comparison
All checks were successful
NTFY Notification / notify (push) Successful in 4s

- 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 <noreply@anthropic.com>
This commit is contained in:
Misaka_Company
2026-02-27 13:07:29 +08:00
parent c08a2f34e1
commit dd931eba53

View File

@@ -117,6 +117,10 @@ Public Function BOMExtraction() As String
Dim allResults As Collection Dim allResults As Collection
Set allResults = New Collection Set allResults = New Collection
' 未过滤的物料集合(用于库存比对工作表)
Dim allRawMaterials As Collection
Set allRawMaterials = New Collection
' 产品编码映射用于BIP上传工作表生成 ' 产品编码映射用于BIP上传工作表生成
Dim productCodeMap As Object Dim productCodeMap As Object
Set productCodeMap = CreateObject("Scripting.Dictionary") Set productCodeMap = CreateObject("Scripting.Dictionary")
@@ -151,9 +155,16 @@ Public Function BOMExtraction() As String
End If End If
Dim modelResults As Collection 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 Dim result As Variant
For Each result In modelResults For Each result In modelResults
allResults.Add result allResults.Add result
@@ -180,8 +191,20 @@ Public Function BOMExtraction() As String
' 步骤5.6: 生成库存比对工作表 ' 步骤5.6: 生成库存比对工作表
Application.StatusBar = "正在生成库存比对数据..." 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 Dim wsInventoryCompare As Worksheet
Set wsInventoryCompare = WriteInventoryComparisonResults(allResults, inputModels) Set wsInventoryCompare = WriteInventoryComparisonResults(componentMaterials, inputModels)
If wsInventoryCompare Is Nothing Then If wsInventoryCompare Is Nothing Then
BOMExtraction = "错误:无法生成库存比对工作表。" BOMExtraction = "错误:无法生成库存比对工作表。"
@@ -367,7 +390,8 @@ Private Function ProcessSingleModel( _
ByVal bomWb As Workbook, _ ByVal bomWb As Workbook, _
ByVal logger As clsErrorLogger, _ ByVal logger As clsErrorLogger, _
ByVal productionOrderNo As String, _ ByVal productionOrderNo As String, _
ByVal orderQty As Long _ ByVal orderQty As Long, _
ByRef outRawMaterials As Collection _
) As Collection ) As Collection
On Error GoTo ErrorHandler On Error GoTo ErrorHandler
@@ -382,6 +406,9 @@ Private Function ProcessSingleModel( _
If params.count = 0 Then If params.count = 0 Then
' 解析失败,添加错误行 ' 解析失败,添加错误行
results.Add GenerateErrorRow(modelString, "型号解析失败:型号格式不正确或缺少必要字段", productionOrderNo, True) results.Add GenerateErrorRow(modelString, "型号解析失败:型号格式不正确或缺少必要字段", productionOrderNo, True)
' 设置输出参数
Set outRawMaterials = New Collection
Set ProcessSingleModel = results Set ProcessSingleModel = results
Exit Function Exit Function
End If End If
@@ -389,7 +416,23 @@ Private Function ProcessSingleModel( _
' 步骤2: 匹配所有物料类型(两阶段) ' 步骤2: 匹配所有物料类型(两阶段)
Dim allMaterials As Collection Dim allMaterials As Collection
Dim validation As Object 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: 生成输出行 ' 步骤3: 生成输出行
Dim remarks As String Dim remarks As String
@@ -416,6 +459,8 @@ Private Function ProcessSingleModel( _
results.Add GenerateErrorRow(modelString, "未匹配到任何物料", productionOrderNo, True) results.Add GenerateErrorRow(modelString, "未匹配到任何物料", productionOrderNo, True)
End If End If
' 设置输出参数
Set outRawMaterials = rawMaterials
Set ProcessSingleModel = results Set ProcessSingleModel = results
Exit Function Exit Function
@@ -457,7 +502,8 @@ Private Function MatchAllMaterialTypesWithValidation( _
ByVal logger As clsErrorLogger, _ ByVal logger As clsErrorLogger, _
ByVal orderQty As Long, _ ByVal orderQty As Long, _
ByVal productionOrderNo As String, _ ByVal productionOrderNo As String, _
ByRef outValidation As Object _ ByRef outValidation As Object, _
ByRef outRawMaterials As Collection _
) As Collection ) As Collection
On Error GoTo ErrorHandler On Error GoTo ErrorHandler
@@ -572,6 +618,9 @@ Private Function MatchAllMaterialTypesWithValidation( _
Dim allMaterials As Collection Dim allMaterials As Collection
Set allMaterials = New Collection Set allMaterials = New Collection
' 初始化未过滤集合(用于库存比对工作表)
Set outRawMaterials = New Collection
If validationResult("valid") Then If validationResult("valid") Then
' 验证通过,收集所有物料 ' 验证通过,收集所有物料
Dim resultKey As Variant Dim resultKey As Variant
@@ -581,7 +630,22 @@ Private Function MatchAllMaterialTypesWithValidation( _
Dim mat As Variant Dim mat As Variant
For Each mat In result("materials") For Each mat In result("materials")
' 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 allMaterials.Add mat
End If
Next mat Next mat
Next resultKey Next resultKey
Else Else
@@ -593,7 +657,22 @@ Private Function MatchAllMaterialTypesWithValidation( _
Dim mat2 As Variant Dim mat2 As Variant
For Each mat2 In result2("materials") For Each mat2 In result2("materials")
' 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 allMaterials.Add mat2
End If
Next mat2 Next mat2
Next resultKey2 Next resultKey2
End If End If
@@ -1408,7 +1487,7 @@ End Function
' 7: 库存充足("是"/"否" ' 7: 库存充足("是"/"否"
' ------------------------------------------------------------------------------ ' ------------------------------------------------------------------------------
Private Function WriteInventoryComparisonResults( _ Private Function WriteInventoryComparisonResults( _
ByVal results As Collection, _ ByVal componentMaterials As Collection, _
ByVal inputModels As Variant _ ByVal inputModels As Variant _
) As Worksheet ) As Worksheet
On Error GoTo ErrorHandler On Error GoTo ErrorHandler
@@ -1416,20 +1495,14 @@ Private Function WriteInventoryComparisonResults( _
Dim ws As Worksheet Dim ws As Worksheet
Dim headers As Variant Dim headers As Variant
Dim c As Long Dim c As Long
Dim modelToOrderMap As Object
Dim i As Long Dim i As Long
Dim j As Long Dim j As Long
Dim result As Variant Dim matInfo As Object
Dim OrderNo As String
Dim modelStr As String
Dim componentResults As Collection
Dim materialType As String
Dim outputArr() As Variant Dim outputArr() As Variant
Dim baseSeqNum As Long Dim baseSeqNum As Long
Dim materialSeqNum As Long Dim materialSeqNum As Long
Dim currentOrderNo As String Dim currentOrderNo As String
Dim prevOrderNo As String Dim prevOrderNo As String
Dim resultOrderNo As String
Dim finalSeqNum As Long Dim finalSeqNum As Long
Dim orderQty As Long Dim orderQty As Long
Dim materialCode As String Dim materialCode As String
@@ -1467,80 +1540,64 @@ Private Function WriteInventoryComparisonResults( _
.HorizontalAlignment = xlCenter .HorizontalAlignment = xlCenter
End With 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列为文本格式 ' 先设置物料编码列第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 baseSeqNum = 0
materialSeqNum = 0 materialSeqNum = 0
currentOrderNo = "" currentOrderNo = ""
prevOrderNo = "" prevOrderNo = ""
Dim isFirstOrder As Boolean
isFirstOrder = True
' 按订单号分组(先排序,确保同一订单的物料连续)
' 由于VBA中没有现成的排序函数我们需要手动处理
' 这里假设componentMaterials已经按订单号分组主循环中按顺序添加
' ======================================== ' ========================================
' 步骤3: 写入库存比对数据 ' 步骤3: 写入库存比对数据
' ======================================== ' ========================================
For i = 1 To componentResults.count Debug.Print "=== WriteInventoryComparisonResults: 开始写入库存比对数据 ==="
result = componentResults(i) Debug.Print " componentMaterials.count = " & componentMaterials.count
' 【关键修复】从映射表中获取订单号 For i = 1 To componentMaterials.count
modelStr = CStr(result(2)) ' 第2列原始产品型号 Set matInfo = componentMaterials(i)
If modelToOrderMap.Exists(modelStr) Then Debug.Print " 物料 [" & i & "]: 编码=[" & matInfo("materialCode") & "], 订单号=[" & matInfo("productionOrderNo") & "]"
resultOrderNo = CStr(modelToOrderMap(modelStr))
' 获取物料编码和名称
materialCode = CStr(matInfo("materialCode"))
materialName = CStr(matInfo("materialName"))
' 获取BOM数量
If IsNumeric(matInfo("materialQty")) Then
bomQty = CLng(matInfo("materialQty"))
Else Else
resultOrderNo = "" bomQty = 1
End If End If
' 获取订单号
currentOrderNo = CStr(matInfo("productionOrderNo"))
' 检测新订单 ' 检测新订单
If resultOrderNo <> prevOrderNo And Len(Trim(resultOrderNo)) > 0 Then If currentOrderNo <> prevOrderNo And Len(Trim(currentOrderNo)) > 0 Then
prevOrderNo = resultOrderNo prevOrderNo = currentOrderNo
currentOrderNo = resultOrderNo
If isFirstOrder Then
' 第一个订单基础序号从10开始
baseSeqNum = 10
isFirstOrder = False
Else
' 后续订单基础序号递增10
baseSeqNum = baseSeqNum + 10 baseSeqNum = baseSeqNum + 10
End If
materialSeqNum = 0 materialSeqNum = 0
End If End If
@@ -1558,17 +1615,6 @@ Private Function WriteInventoryComparisonResults( _
End If End If
Next j 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( _ Set invInfo = M08_ComponentProcessor.GetComponentInventoryInfo( _
materialCode, bomQty, orderQty) materialCode, bomQty, orderQty)
@@ -1582,7 +1628,7 @@ Private Function WriteInventoryComparisonResults( _
' 填充输出数组 ' 填充输出数组
outputArr(i, 1) = finalSeqNum ' 序号 outputArr(i, 1) = finalSeqNum ' 序号
outputArr(i, 2) = currentOrderNo ' 【关键修复】生产订单号 outputArr(i, 2) = currentOrderNo ' 生产订单号
outputArr(i, 3) = materialCode ' 物料编码 outputArr(i, 3) = materialCode ' 物料编码
outputArr(i, 4) = materialName ' 物料名称 outputArr(i, 4) = materialName ' 物料名称
outputArr(i, 5) = requiredQty ' 所需数量 outputArr(i, 5) = requiredQty ' 所需数量
@@ -1591,16 +1637,16 @@ Private Function WriteInventoryComparisonResults( _
Next i 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.LineStyle = xlContinuous
.Borders.Weight = xlThin .Borders.Weight = xlThin
End With End With
' 根据库存状态设置背景色 ' 根据库存状态设置背景色
For i = 1 To componentResults.count For i = 1 To componentMaterials.count
suffStatus = CStr(outputArr(i, 7)) suffStatus = CStr(outputArr(i, 7))
If suffStatus = "否" Then If suffStatus = "否" Then