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

refactor: remove debug output and update order logic

Browse Source 
- Commented out verbose Debug.Print statements in `GetMaterialsByModel` and `FilterCategoryWithSubcategories` to reduce console noise.
- Added validation checks to ensure required worksheets ('平台配置清单', '产品订单') exist before loading data.
- Refactored order processing logic to aggregate results into a Collection for structured output generation, including headers.
This commit is contained in:
Misaka_Company
2026-01-26 09:13:27 +08:00
parent 40a9fe99f4
commit 255bcdb5fe
10 changed files with 474 additions and 60 deletions
Download Patch File Download Diff File Expand all files Collapse all files

382
VBA/Modules/modModelParserExamples.bas
View File

@@ -87,7 +87,7 @@ Sub Example1_GeneratePickingListByModel()
wsPickList.Cells(row, 3).value = mat.Name
wsPickList.Cells(row, 4).value = mat.Quantity
wsPickList.Cells(row, 5).value = IIf(mat.Condition = "", "(无条件)", mat.Condition)
wsPickList.Cells(row, 6).value = "✓"
wsPickList.Cells(row, 6).value = "??"
row = row + 1
Next j
Next i
@@ -486,9 +486,9 @@ Sub Example6_CompareAutoFallback()
wsCompare.Cells(row, 1).value = "说明:"
wsCompare.Cells(row, 1).Font.Bold = True
row = row + 1
wsCompare.Cells(row, 1).value = "• autoFallback=True (默认): 当""部件""类别无匹配物料时,自动降级到子类别""接头""、""弹性元件""等查找"
wsCompare.Cells(row, 1).value = "?? autoFallback=True (默认): 当""部件""类别无匹配物料时,自动降级到子类别""接头""、""弹性元件""等查找"
row = row + 1
wsCompare.Cells(row, 1).value = "• autoFallback=False: 仅在""部件""类别查找,即使有子类别也不降级,可能返回空集合"
wsCompare.Cells(row, 1).value = "?? autoFallback=False: 仅在""部件""类别查找,即使有子类别也不降级,可能返回空集合"
' 格式化
wsCompare.Columns("A:E").AutoFit
@@ -554,7 +554,7 @@ Sub Example7_TestGetValidMaterialsByModel()
Dim materials As collection
Dim missingCats As collection
Dim isComplete As Boolean
Set materials = result("Materials")
Set missingCats = result("MissingCategories") ' 直接获取缺失列表
isComplete = result("IsComplete")
@@ -570,7 +570,7 @@ Sub Example7_TestGetValidMaterialsByModel()
row = row + 1
wsTest.Cells(row, 1).value = "完整性:"
wsTest.Cells(row, 2).value = IIf(isComplete, "✓ 完整", "✕ 不完整")
wsTest.Cells(row, 2).value = IIf(isComplete, "?? 完整", "?? 不完整")
If isComplete Then
wsTest.Cells(row, 2).Font.Color = RGB(0, 128, 0)
Else
@@ -578,12 +578,12 @@ Sub Example7_TestGetValidMaterialsByModel()
End If
wsTest.Cells(row, 2).Font.Bold = True
row = row + 1
' 3. 打印匹配到的物料
wsTest.Cells(row, 1).value = "【已匹配物料】"
wsTest.Cells(row, 1).Font.Bold = True
row = row + 1
wsTest.Cells(row, 1).value = "类别"
wsTest.Cells(row, 2).value = "代号"
wsTest.Cells(row, 3).value = "名称"
@@ -591,9 +591,9 @@ Sub Example7_TestGetValidMaterialsByModel()
wsTest.Range(wsTest.Cells(row, 1), wsTest.Cells(row, 4)).Font.Bold = True
wsTest.Range(wsTest.Cells(row, 1), wsTest.Cells(row, 4)).Interior.Color = RGB(220, 220, 220)
row = row + 1
Dim mat As clsMaterialItem
If materials.count > 0 Then
If materials.Count > 0 Then
For Each mat In materials
wsTest.Cells(row, 1).value = mat.Category
wsTest.Cells(row, 2).value = mat.code
@@ -605,18 +605,18 @@ Sub Example7_TestGetValidMaterialsByModel()
wsTest.Cells(row, 1).value = "(无)"
row = row + 1
End If
' 4. 打印缺失的类别 (新增核心功能)
If missingCats.count > 0 Then
If missingCats.Count > 0 Then
row = row + 1
wsTest.Cells(row, 1).value = "【缺失类别】"
wsTest.Cells(row, 1).Font.Color = RGB(255, 0, 0)
wsTest.Cells(row, 1).Font.Bold = True
row = row + 1
Dim catName As Variant
For Each catName In missingCats
wsTest.Cells(row, 1).value = "❌ " & catName
wsTest.Cells(row, 1).value = "?? " & catName
wsTest.Cells(row, 1).Font.Color = RGB(255, 0, 0)
wsTest.Cells(row, 2).value = "未找到匹配物料"
row = row + 1
@@ -631,4 +631,360 @@ Sub Example7_TestGetValidMaterialsByModel()
wsTest.Columns("A:D").AutoFit
MsgBox "测试完成！", vbInformation
End Sub
' ========================================
' 示例8: 批量处理产品订单，生成物料清单
' ========================================
Sub Example8_BatchProcessOrders()
Dim bomMgr As New clsBOMManager
Dim wsConfig As Worksheet
Dim wsPlatform As Worksheet
Dim wsOrders As Worksheet
Dim wsOutput As Worksheet
' 加载配置
On Error Resume Next
Set wsConfig = ThisWorkbook.Worksheets("领料配置")
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
Set wsOrders = ThisWorkbook.Worksheets("产品订单")
If wsConfig Is Nothing Then
MsgBox "找不到工作表: 领料配置", vbCritical
Exit Sub
End If
If wsPlatform Is Nothing Then
MsgBox "找不到工作表: 平台配置清单", vbCritical
Exit Sub
End If
If wsOrders Is Nothing Then
MsgBox "找不到工作表: 产品订单", vbCritical
Exit Sub
End If
On Error GoTo 0
bomMgr.LoadData wsConfig, wsPlatform
' 读取订单数据
Dim lastRow As Long
lastRow = wsOrders.Cells(wsOrders.Rows.Count, "A").End(xlUp).row
If lastRow < 2 Then
MsgBox "产品订单工作表没有数据！" & vbCrLf & _
"请确保第一行是表头，从第二行开始是数据。", vbExclamation
Exit Sub
End If
' 使用 Collection 收集所有输出行
Dim outputData As collection
Set outputData = New collection
' 添加表头
outputData.Add Array("来源单号", "产品型号", "物料代码", "物料名称", "数量", "选择条件", "类别")
' 遍历每个订单，收集数据
Dim i As Long
Dim orderNo As String
Dim modelStr As String
Dim materials As collection
Dim mat As clsMaterialItem
Dim processedCount As Long
Dim materialCount As Long
processedCount = 0
materialCount = 0
For i = 2 To lastRow
orderNo = Trim(wsOrders.Cells(i, 1).value)
modelStr = Trim(wsOrders.Cells(i, 2).value)
' 跳过空行
If orderNo = "" And modelStr = "" Then
GoTo ContinueLoop
End If
' 验证必填字段
If orderNo = "" Then
orderNo = "(未填写)"
End If
If modelStr = "" Then
outputData.Add Array(orderNo, "(空白型号)", "错误", "产品型号为空", "", "", "")
GoTo ContinueLoop
End If
' 获取物料
On Error Resume Next
Set materials = bomMgr.GetMaterialsByModel(modelStr, "", True)
On Error GoTo 0
If materials Is Nothing Then
outputData.Add Array(orderNo, modelStr, "错误", "无法解析型号或获取物料", "", "", "")
GoTo ContinueLoop
End If
' 收集物料明细
If materials.Count > 0 Then
For Each mat In materials
outputData.Add Array( _
orderNo, _
modelStr, _
mat.code, _
mat.Name, _
mat.Quantity, _
IIf(mat.Condition = "", "(无条件)", mat.Condition), _
mat.Category _
)
materialCount = materialCount + 1
Next mat
Else
outputData.Add Array(orderNo, modelStr, "(无)", "未找到任何匹配物料", "", "", "")
End If
processedCount = processedCount + 1
ContinueLoop:
Next i
' 创建输出工作表
On Error Resume Next
Application.DisplayAlerts = False
ThisWorkbook.Worksheets("产品订单物料清单").Delete
Application.DisplayAlerts = True
On Error GoTo 0
Set wsOutput = ThisWorkbook.Worksheets.Add
wsOutput.Name = "产品订单物料清单"
' 批量写入数据到工作表
If outputData.Count > 0 Then
Dim dataArray() As Variant
ReDim dataArray(1 To outputData.Count, 1 To 7)
Dim j As Long
Dim rowArr As Variant
For j = 1 To outputData.Count
rowArr = outputData(j)
dataArray(j, 1) = rowArr(0)
dataArray(j, 2) = rowArr(1)
dataArray(j, 3) = rowArr(2) ' 这里是物料代码
dataArray(j, 4) = rowArr(3)
dataArray(j, 5) = rowArr(4)
dataArray(j, 6) = rowArr(5)
dataArray(j, 7) = rowArr(6)
Next j
' --- 关键修改：在写入数据前，将 C 列设置为文本格式 ---
' 使用 NumberFormat = "@" 强制指定为文本格式
wsOutput.Columns("C").NumberFormat = "@"
' 一次性写入
wsOutput.Range("A1").Resize(outputData.Count, 7).value = dataArray
' 格式化表头
With wsOutput.Range("A1:G1")
.Font.Bold = True
.Interior.Color = RGB(200, 200, 200)
' 表头所在的 C1 单元格通常可以改回常规格式，或者保持文本格式也不影响
.NumberFormat = "General"
End With
End If
' 格式化
wsOutput.Columns("A:G").AutoFit
' 显示统计信息
Dim msg As String
msg = "批量处理完成！" & vbCrLf & vbCrLf
msg = msg & "处理订单数: " & processedCount & vbCrLf
msg = msg & "生成物料记录: " & materialCount & " 条" & vbCrLf & vbCrLf
msg = msg & "请查看工作表: 产品订单物料清单"
MsgBox msg, vbInformation
End Sub
' ========================================
' 示例9: 批量处理订单 - 带完整性检查与模块数量校验
' 功能：
' 1. 提取型号条件
' 2. 校验模块数量（如果是3个模块则报错）
' 3. 校验类别完整性（如果缺失类别则报错）
' 4. 生成BOM清单
' ========================================
Sub Example9_BatchProcessOrders_WithCheck()
Dim bomMgr As New clsBOMManager
Dim wsConfig As Worksheet, wsPlatform As Worksheet, wsOrders As Worksheet, wsOutput As Worksheet
Dim parser As clsModelParser
Dim extractor As clsConditionExtractor
' 1. 初始化与加载数据
On Error Resume Next
Set wsConfig = ThisWorkbook.Worksheets("领料配置")
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
Set wsOrders = ThisWorkbook.Worksheets("产品订单")
On Error GoTo 0
If wsConfig Is Nothing Or wsPlatform Is Nothing Or wsOrders Is Nothing Then
MsgBox "错误：缺少必要的工作表 (领料配置/平台配置清单/产品订单)", vbCritical
Exit Sub
End If
bomMgr.LoadData wsConfig, wsPlatform
' 2. 准备输出容器
Dim outputData As collection
Set outputData = New collection
' 添加表头
outputData.Add Array("来源单号", "产品型号", "物料代码", "物料名称", "数量", "选择条件", "提取的物料选择条件", "类别", "备注")
' 3. 遍历订单
Dim lastRow As Long
lastRow = wsOrders.Cells(wsOrders.Rows.Count, "A").End(xlUp).row
Dim i As Long
Dim orderNo As String, modelStr As String
Dim extractedCondStr As String
Dim parts() As String
Dim moduleCount As Integer
Dim result As collection, materials As collection, missingCats As collection
Dim isComplete As Boolean
Dim mat As clsMaterialItem
' 辅助变量
Dim key As Variant
Dim missingStr As String
Dim catItem As Variant
For i = 2 To lastRow
orderNo = Trim(wsOrders.Cells(i, 1).value)
modelStr = Trim(wsOrders.Cells(i, 2).value)
If orderNo = "" And modelStr = "" Then GoTo NextOrder
If orderNo = "" Then orderNo = "(未填写)"
' -------------------------------------------------
' 步骤 A: 解析型号并提取条件字符串 (用于输出列)
' -------------------------------------------------
extractedCondStr = ""
Set parser = New clsModelParser
Set extractor = New clsConditionExtractor
If parser.ParseModel(modelStr) Then
Dim conditions As Object
Set conditions = extractor.ExtractConditions(parser)
For Each key In conditions.Keys
extractedCondStr = extractedCondStr & key & "=" & conditions(key) & "; "
Next key
If Len(extractedCondStr) > 2 Then extractedCondStr = Left(extractedCondStr, Len(extractedCondStr) - 2)
Else
' 解析失败直接输出错误
outputData.Add Array(orderNo, modelStr, "", "", "", "", "", "", "解析失败: " & parser.ErrorMessage)
GoTo NextOrder
End If
' -------------------------------------------------
' 步骤 B: 校验模块数量 (表头 | 表盘 | 附件 | 法兰)
' -------------------------------------------------
' Split返回0-based数组。0=1个模块, 1=2个模块, 2=3个模块
parts = Split(modelStr, "|")
moduleCount = UBound(parts) + 1
' 规则：如果出现三个模块，不输出物料，备注填入原因
If moduleCount = 3 Then
outputData.Add Array(orderNo, modelStr, "", "", "", "", extractedCondStr, "", "包含其它模块")
GoTo NextOrder
End If
' -------------------------------------------------
' 步骤 C: 获取物料并校验类别完整性
' -------------------------------------------------
Set result = bomMgr.GetValidMaterialsByModel(modelStr)
isComplete = result("IsComplete")
Set materials = result("Materials")
Set missingCats = result("MissingCategories")
' 规则：如果类别缺失，不输出物料，备注填入缺失的类别
If Not isComplete Then
missingStr = ""
For Each catItem In missingCats
missingStr = missingStr & catItem & ", "
Next catItem
If Len(missingStr) > 2 Then missingStr = Left(missingStr, Len(missingStr) - 2)
If missingStr = "" Then missingStr = "完整性校验未通过(未知原因)" ' 防御性编程
outputData.Add Array(orderNo, modelStr, "", "", "", "", extractedCondStr, "", "类别缺失: " & missingStr)
GoTo NextOrder
End If
' -------------------------------------------------
' 步骤 D: 正常输出物料
' -------------------------------------------------
If materials.Count > 0 Then
For Each mat In materials
outputData.Add Array( _
orderNo, _
modelStr, _
mat.code, _
mat.Name, _
mat.Quantity, _
IIf(mat.Condition = "", "(无条件)", mat.Condition), _
extractedCondStr, _
mat.Category, _
"" _
)
Next mat
Else
outputData.Add Array(orderNo, modelStr, "", "", "", "", extractedCondStr, "", "无匹配物料")
End If
NextOrder:
Next i
' 4. 写入结果到新工作表
On Error Resume Next
Application.DisplayAlerts = False
ThisWorkbook.Worksheets("订单BOM_校验版").Delete
Application.DisplayAlerts = True
On Error GoTo 0
Set wsOutput = ThisWorkbook.Worksheets.Add
wsOutput.Name = "订单BOM_校验版"
If outputData.Count > 0 Then
' 转换为二维数组以提高写入速度
Dim dataArr() As Variant
ReDim dataArr(1 To outputData.Count, 1 To 9)
Dim r As Long, c As Long
Dim rowItem As Variant
For r = 1 To outputData.Count
rowItem = outputData(r)
For c = 0 To 8
dataArr(r, c + 1) = rowItem(c)
Next c
Next r
' 设置物料代码列(C列)为文本格式
wsOutput.Columns("C:C").NumberFormat = "@"
' 写入数据
wsOutput.Range("A1").Resize(outputData.Count, 9).value = dataArr
' 格式化美化
With wsOutput.Range("A1:I1")
.Font.Bold = True
.Interior.Color = RGB(220, 230, 241)
.HorizontalAlignment = xlCenter
End With
wsOutput.Columns("A:I").AutoFit
' 备注列标红显示
wsOutput.Columns("I:I").Font.Color = RGB(255, 0, 0)
wsOutput.Cells(1, 9).Font.Color = RGB(0, 0, 0) ' 表头改回黑色
End If
MsgBox "处理完成！请查看工作表 '订单BOM_校验版'。", vbInformation
End Sub