admin/AutoBOM
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source 
- 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
1 changed files with 136 additions and 90 deletions
Download Patch File Download Diff File Expand all files Collapse all files

226
VBA_BOMConverter/Modules/M09_BOMExtractor.bas
View File

@@ -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