c9cf84ed4d
Changes:
1. Update all modules to use LoadData(wsPlatform) instead of LoadData(wsConfig, wsPlatform)
- modModelParserExamples.bas: Update 7 example procedures
- modBOMProcessor.bas: Update 4 procedures
- modModelParserTest.bas: Update 2 test procedures
2. Fix completeness check logic in GetValidMaterialsByModel
- Only check root categories to avoid duplicate checking of subcategories
- Previously, all required categories (including subcategories) were checked,
causing subcategories to be added to missing list multiple times
- Now only checks categories with ParentCategoryName = ""
- CheckCategoryCompleteness already recursively checks all subcategories
3. Improve completeness judgment logic for categories with subcategories
- Method 1: Parent category has 1 matching material → Complete
- Method 2: Parent category has 0 matching materials, but all subcategories are complete → Complete
- Other cases → Incomplete
Impact:
- Fixes "category missing" errors in Example9_BatchProcessOrders_WithCheck
- Eliminates duplicate entries in missing categories list
- Properly handles category hierarchy where parent categories are satisfied through subcategories
Co-Authored-By: Claude Sonnet 4.5 <noreply@anthropic.com>
986 lines
33 KiB
QBasic
986 lines
33 KiB
QBasic
' ========================================
|
||
' 模块: modModelParserExamples
|
||
' 用途: 型号解析与物料匹配的实际应用示例
|
||
' ========================================
|
||
Option Explicit
|
||
|
||
' ========================================
|
||
' 示例1: 根据型号生成完整的领料清单
|
||
' ⭐ v2.0 更新：使用新的 LoadData(wsPlatform) 接口
|
||
' ========================================
|
||
Sub Example1_GeneratePickingListByModel()
|
||
Dim bomMgr As New clsBOMManager
|
||
Dim wsPlatform As Worksheet
|
||
|
||
' 加载配置
|
||
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
|
||
bomMgr.LoadData wsPlatform
|
||
|
||
' 产品型号
|
||
Dim modelStr As String
|
||
modelStr = "YTHN-100.A0.532.M203.M16.Y3|BP-095.2312.M16.PA3"
|
||
|
||
' 创建领料清单工作表
|
||
Dim wsPickList As Worksheet
|
||
On Error Resume Next
|
||
Application.DisplayAlerts = False
|
||
ThisWorkbook.Worksheets("型号领料清单").Delete
|
||
Application.DisplayAlerts = True
|
||
On Error GoTo 0
|
||
|
||
Set wsPickList = ThisWorkbook.Worksheets.Add
|
||
wsPickList.Name = "型号领料清单"
|
||
|
||
' 写入表头
|
||
Dim row As Long
|
||
row = 1
|
||
wsPickList.Cells(row, 1).value = "产品型号"
|
||
wsPickList.Cells(row, 2).value = modelStr
|
||
row = row + 1
|
||
|
||
' 提取条件并显示
|
||
Dim conditions As Object
|
||
Set conditions = bomMgr.ParseModelAndExtractConditions(modelStr)
|
||
wsPickList.Cells(row, 1).value = "提取条件"
|
||
Dim condStr As String
|
||
Dim key As Variant
|
||
For Each key In conditions.Keys
|
||
condStr = condStr & key & "=" & conditions(key) & "; "
|
||
Next key
|
||
wsPickList.Cells(row, 2).value = condStr
|
||
row = row + 2
|
||
|
||
' 表头
|
||
wsPickList.Cells(row, 1).value = "类别"
|
||
wsPickList.Cells(row, 2).value = "代号"
|
||
wsPickList.Cells(row, 3).value = "名称"
|
||
wsPickList.Cells(row, 4).value = "数量"
|
||
wsPickList.Cells(row, 5).value = "选择条件"
|
||
wsPickList.Cells(row, 6).value = "匹配状态"
|
||
wsPickList.Range("A" & row & ":F" & row).Font.Bold = True
|
||
row = row + 1
|
||
|
||
' 遍历所有根类别
|
||
Dim rootCats As collection
|
||
Set rootCats = bomMgr.GetRootCategories
|
||
|
||
Dim cat As clsCategory
|
||
Dim materials As collection
|
||
Dim mat As clsMaterialItem
|
||
Dim i As Long
|
||
|
||
For i = 1 To rootCats.Count
|
||
Set cat = rootCats(i)
|
||
|
||
' 获取该类别符合条件的物料
|
||
Set materials = bomMgr.GetMaterialsByModel(modelStr, cat.categoryName)
|
||
|
||
' 写入物料
|
||
Dim j As Long
|
||
For j = 1 To materials.Count
|
||
Set mat = materials(j)
|
||
' 使用物料自己的Category属性，而不是外层循环的类别名称
|
||
' 这样当GetMaterialsByModel降级到子类别查找时，能正确显示子类别名称
|
||
wsPickList.Cells(row, 1).value = mat.Category
|
||
wsPickList.Cells(row, 2).value = mat.code
|
||
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 = "??"
|
||
row = row + 1
|
||
Next j
|
||
Next i
|
||
|
||
' 格式化
|
||
wsPickList.Columns("A:F").AutoFit
|
||
|
||
MsgBox "领料清单生成完成！" & vbCrLf & _
|
||
"请查看工作表: 型号领料清单", vbInformation
|
||
End Sub
|
||
|
||
' ========================================
|
||
' 示例2: 批量处理多个型号
|
||
' ⭐ v2.0 更新：使用新的 LoadData(wsPlatform) 接口
|
||
' ========================================
|
||
Sub Example2_BatchProcessModels()
|
||
Dim bomMgr As New clsBOMManager
|
||
Dim wsPlatform As Worksheet
|
||
|
||
' 加载配置
|
||
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
|
||
bomMgr.LoadData wsPlatform
|
||
|
||
' 型号列表
|
||
Dim models() As String
|
||
models = Split("YTHN-100.A0.532.M203.M16.Y3|BP-095.2312.M16.PA3," & _
|
||
"YTHN-100.A0.532.M203.M02.Y3|BP-095.2312.M02.PA3," & _
|
||
"YTHN-100.A0.532.M203.M12.Y3|BP-095.2312.M12.PA3", ",")
|
||
|
||
' 创建汇总表
|
||
Dim wsReport As Worksheet
|
||
On Error Resume Next
|
||
Application.DisplayAlerts = False
|
||
ThisWorkbook.Worksheets("批量型号汇总").Delete
|
||
Application.DisplayAlerts = True
|
||
On Error GoTo 0
|
||
|
||
Set wsReport = ThisWorkbook.Worksheets.Add
|
||
wsReport.Name = "批量型号汇总"
|
||
|
||
' 表头
|
||
Dim row As Long
|
||
row = 1
|
||
wsReport.Cells(row, 1).value = "型号"
|
||
wsReport.Cells(row, 2).value = "提取条件"
|
||
wsReport.Cells(row, 3).value = "匹配物料数"
|
||
wsReport.Cells(row, 4).value = "部件物料"
|
||
wsReport.Range("A1:D1").Font.Bold = True
|
||
row = row + 1
|
||
|
||
' 处理每个型号
|
||
Dim modelStr As String
|
||
Dim i As Long
|
||
|
||
For i = LBound(models) To UBound(models)
|
||
modelStr = Trim(models(i))
|
||
If modelStr <> "" Then
|
||
' 提取条件
|
||
Dim conditions As Object
|
||
Set conditions = bomMgr.ParseModelAndExtractConditions(modelStr)
|
||
|
||
Dim condStr As String
|
||
condStr = ""
|
||
Dim key As Variant
|
||
For Each key In conditions.Keys
|
||
condStr = condStr & key & "=" & conditions(key) & "; "
|
||
Next key
|
||
|
||
' 获取物料
|
||
Dim materials As collection
|
||
Set materials = bomMgr.GetMaterialsByModel(modelStr, "部件")
|
||
|
||
' 写入结果
|
||
wsReport.Cells(row, 1).value = modelStr
|
||
wsReport.Cells(row, 2).value = condStr
|
||
wsReport.Cells(row, 3).value = materials.Count
|
||
|
||
' 列出部件物料
|
||
Dim matList As String
|
||
matList = ""
|
||
Dim mat As clsMaterialItem
|
||
For Each mat In materials
|
||
matList = matList & mat.code & "(" & mat.Name & "); "
|
||
Next mat
|
||
wsReport.Cells(row, 4).value = matList
|
||
|
||
row = row + 1
|
||
End If
|
||
Next i
|
||
|
||
' 格式化
|
||
wsReport.Columns("A:D").AutoFit
|
||
|
||
MsgBox "批量处理完成！", vbInformation
|
||
End Sub
|
||
|
||
' ========================================
|
||
' 示例3: 查询并显示某个型号的详细信息
|
||
' ========================================
|
||
Sub Example3_ShowModelDetails()
|
||
' 弹出输入框
|
||
Dim modelStr As String
|
||
modelStr = InputBox("请输入产品型号:", "型号查询", _
|
||
"YTHN-100.A0.532.M203.M16.Y3")
|
||
|
||
If modelStr = "" Then Exit Sub
|
||
|
||
' 解析型号
|
||
Dim parser As New clsModelParser
|
||
If Not parser.ParseModel(modelStr) Then
|
||
MsgBox "型号解析失败: " & parser.ErrorMessage, vbCritical
|
||
Exit Sub
|
||
End If
|
||
|
||
' 提取条件
|
||
Dim extractor As New clsConditionExtractor
|
||
Dim conditions As Object
|
||
Set conditions = extractor.ExtractConditions(parser)
|
||
|
||
' 显示详细信息
|
||
Dim msg As String
|
||
msg = "【型号解析结果】" & vbCrLf & vbCrLf
|
||
msg = msg & "原始型号: " & parser.RawModel & vbCrLf
|
||
msg = msg & "表头型号: " & parser.HeaderModel & vbCrLf
|
||
msg = msg & "表盘型号: " & parser.DialModel & vbCrLf & vbCrLf
|
||
|
||
msg = msg & "【表头各部分】" & vbCrLf
|
||
msg = msg & "型号: " & parser.ModelType & vbCrLf
|
||
msg = msg & "公称外径: " & parser.Diameter & vbCrLf
|
||
msg = msg & "安装形式: " & parser.InstallForm & vbCrLf
|
||
msg = msg & "壳体形式: " & parser.ShellForm & vbCrLf
|
||
msg = msg & "过程连接&材质: " & parser.ConnectionCode & vbCrLf
|
||
msg = msg & "量程范围: " & parser.RangeCode & vbCrLf
|
||
msg = msg & "仪表特性: " & parser.Characteristics & vbCrLf & vbCrLf
|
||
|
||
msg = msg & "【提取的物料选择条件】" & vbCrLf
|
||
Dim key As Variant
|
||
For Each key In conditions.Keys
|
||
msg = msg & key & " = " & conditions(key) & vbCrLf
|
||
Next key
|
||
|
||
MsgBox msg, vbInformation, "型号详细信息"
|
||
End Sub
|
||
|
||
' ========================================
|
||
' 示例4: 对比两个型号的差异
|
||
' ========================================
|
||
Sub Example4_CompareModels()
|
||
Dim model1 As String, model2 As String
|
||
|
||
model1 = InputBox("请输入第一个型号:", "型号对比", _
|
||
"YTHN-100.A0.532.M203.M16.Y3")
|
||
If model1 = "" Then Exit Sub
|
||
|
||
model2 = InputBox("请输入第二个型号:", "型号对比", _
|
||
"YTHN-100.A0.532.M203.M02.Y3")
|
||
If model2 = "" Then Exit Sub
|
||
|
||
' 解析两个型号
|
||
Dim parser1 As New clsModelParser
|
||
Dim parser2 As New clsModelParser
|
||
Dim extractor As New clsConditionExtractor
|
||
|
||
parser1.ParseModel model1
|
||
parser2.ParseModel model2
|
||
|
||
Dim cond1 As Object, cond2 As Object
|
||
Set cond1 = extractor.ExtractConditions(parser1)
|
||
|
||
Set extractor = New clsConditionExtractor
|
||
Set cond2 = extractor.ExtractConditions(parser2)
|
||
|
||
' 对比
|
||
Dim msg As String
|
||
msg = "【型号对比】" & vbCrLf & vbCrLf
|
||
msg = msg & "型号1: " & model1 & vbCrLf
|
||
msg = msg & "型号2: " & model2 & vbCrLf & vbCrLf
|
||
|
||
msg = msg & "【条件差异】" & vbCrLf
|
||
Dim key As Variant
|
||
Dim allKeys As Object
|
||
Set allKeys = CreateObject("Scripting.Dictionary")
|
||
|
||
For Each key In cond1.Keys
|
||
allKeys(key) = True
|
||
Next key
|
||
For Each key In cond2.Keys
|
||
allKeys(key) = True
|
||
Next key
|
||
|
||
For Each key In allKeys.Keys
|
||
Dim val1 As String, val2 As String
|
||
val1 = ""
|
||
val2 = ""
|
||
|
||
If cond1.Exists(key) Then val1 = cond1(key)
|
||
If cond2.Exists(key) Then val2 = cond2(key)
|
||
|
||
If val1 <> val2 Then
|
||
msg = msg & key & ": " & val1 & " → " & val2 & " ?" & vbCrLf
|
||
Else
|
||
msg = msg & key & ": " & val1 & " ?" & vbCrLf
|
||
End If
|
||
Next key
|
||
|
||
MsgBox msg, vbInformation, "型号对比结果"
|
||
End Sub
|
||
|
||
' ========================================
|
||
' 示例5: 验证物料选择条件的有效性
|
||
' ⭐ v2.0 更新：使用新的 LoadData(wsPlatform) 接口
|
||
' ========================================
|
||
Sub Example5_ValidateMaterialConditions()
|
||
Dim bomMgr As New clsBOMManager
|
||
Dim wsPlatform As Worksheet
|
||
|
||
' 加载配置
|
||
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
|
||
bomMgr.LoadData wsPlatform
|
||
|
||
' 创建验证结果表
|
||
Dim wsValidation As Worksheet
|
||
On Error Resume Next
|
||
Application.DisplayAlerts = False
|
||
ThisWorkbook.Worksheets("条件验证结果").Delete
|
||
Application.DisplayAlerts = True
|
||
On Error GoTo 0
|
||
|
||
Set wsValidation = ThisWorkbook.Worksheets.Add
|
||
wsValidation.Name = "条件验证结果"
|
||
|
||
' 表头
|
||
Dim row As Long
|
||
row = 1
|
||
wsValidation.Cells(row, 1).value = "代号"
|
||
wsValidation.Cells(row, 2).value = "名称"
|
||
wsValidation.Cells(row, 3).value = "选择条件"
|
||
wsValidation.Cells(row, 4).value = "验证结果"
|
||
wsValidation.Range("A1:D1").Font.Bold = True
|
||
row = row + 1
|
||
|
||
' 获取所有根类别
|
||
Dim rootCats As collection
|
||
Set rootCats = bomMgr.GetRootCategories
|
||
|
||
Dim cat As clsCategory
|
||
Dim materials As collection
|
||
Dim mat As clsMaterialItem
|
||
Dim matcher As New clsConditionMatcher
|
||
Dim i As Long
|
||
|
||
' 遍历所有物料
|
||
For i = 1 To rootCats.Count
|
||
Set cat = rootCats(i)
|
||
Set materials = New collection
|
||
|
||
' 收集该类别的所有物料
|
||
Dim j As Long
|
||
For j = 1 To cat.materials.Count
|
||
materials.Add cat.materials(j)
|
||
Next j
|
||
|
||
' 验证每个物料的条件
|
||
For Each mat In materials
|
||
wsValidation.Cells(row, 1).value = mat.code
|
||
wsValidation.Cells(row, 2).value = mat.Name
|
||
wsValidation.Cells(row, 3).value = IIf(mat.Condition = "", "(无)", mat.Condition)
|
||
|
||
If mat.Condition = "" Then
|
||
wsValidation.Cells(row, 4).value = "? 无条件"
|
||
Else
|
||
Dim validResult As String
|
||
validResult = matcher.TestExpression(mat.Condition)
|
||
wsValidation.Cells(row, 4).value = validResult
|
||
End If
|
||
|
||
row = row + 1
|
||
Next mat
|
||
Next i
|
||
|
||
' 格式化
|
||
wsValidation.Columns("A:D").AutoFit
|
||
|
||
MsgBox "条件验证完成！", vbInformation
|
||
End Sub
|
||
|
||
' ========================================
|
||
' 示例6: 对比启用/禁用自动降级的效果
|
||
' ⭐ v2.0 更新：使用新的 LoadData(wsPlatform) 接口
|
||
' ========================================
|
||
Sub Example6_CompareAutoFallback()
|
||
Dim bomMgr As New clsBOMManager
|
||
Dim wsPlatform As Worksheet
|
||
|
||
' 加载配置
|
||
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
|
||
bomMgr.LoadData wsPlatform
|
||
|
||
' 产品型号（使用可能导致类别缺失的型号）
|
||
Dim modelStr As String
|
||
modelStr = "YTHN-100.A0.532.M203.M17.Y3|BP-095.2312.M16.PA3"
|
||
|
||
' 创建对比结果表
|
||
Dim wsCompare As Worksheet
|
||
On Error Resume Next
|
||
Application.DisplayAlerts = False
|
||
ThisWorkbook.Worksheets("降级模式对比").Delete
|
||
Application.DisplayAlerts = True
|
||
On Error GoTo 0
|
||
|
||
Set wsCompare = ThisWorkbook.Worksheets.Add
|
||
wsCompare.Name = "降级模式对比"
|
||
|
||
' 表头
|
||
Dim row As Long
|
||
row = 1
|
||
wsCompare.Cells(row, 1).value = "型号"
|
||
wsCompare.Cells(row, 2).value = modelStr
|
||
row = row + 2
|
||
|
||
' 测试1: 启用自动降级
|
||
wsCompare.Cells(row, 1).value = "模式1: 启用自动降级 (autoFallback=True)"
|
||
wsCompare.Cells(row, 1).Font.Bold = True
|
||
row = row + 1
|
||
|
||
wsCompare.Cells(row, 1).value = "类别"
|
||
wsCompare.Cells(row, 2).value = "代号"
|
||
wsCompare.Cells(row, 3).value = "名称"
|
||
wsCompare.Cells(row, 4).value = "数量"
|
||
wsCompare.Cells(row, 5).value = "选择条件"
|
||
wsCompare.Range("A" & row & ":E" & row).Font.Bold = True
|
||
row = row + 1
|
||
|
||
Dim materials As collection
|
||
Dim mat As clsMaterialItem
|
||
Dim i As Long
|
||
|
||
' 获取启用自动降级的物料
|
||
Set materials = bomMgr.GetMaterialsByModel(modelStr, "部件", True)
|
||
|
||
If materials.Count = 0 Then
|
||
wsCompare.Cells(row, 1).value = "(无物料)"
|
||
row = row + 1
|
||
Else
|
||
For i = 1 To materials.Count
|
||
Set mat = materials(i)
|
||
wsCompare.Cells(row, 1).value = mat.Category
|
||
wsCompare.Cells(row, 2).value = mat.code
|
||
wsCompare.Cells(row, 3).value = mat.Name
|
||
wsCompare.Cells(row, 4).value = mat.Quantity
|
||
wsCompare.Cells(row, 5).value = IIf(mat.Condition = "", "(无)", mat.Condition)
|
||
row = row + 1
|
||
Next i
|
||
End If
|
||
|
||
row = row + 1
|
||
|
||
' 测试2: 禁用自动降级
|
||
wsCompare.Cells(row, 1).value = "模式2: 禁用自动降级 (autoFallback=False)"
|
||
wsCompare.Cells(row, 1).Font.Bold = True
|
||
row = row + 1
|
||
|
||
wsCompare.Cells(row, 1).value = "类别"
|
||
wsCompare.Cells(row, 2).value = "代号"
|
||
wsCompare.Cells(row, 3).value = "名称"
|
||
wsCompare.Cells(row, 4).value = "数量"
|
||
wsCompare.Cells(row, 5).value = "选择条件"
|
||
wsCompare.Range("A" & row & ":E" & row).Font.Bold = True
|
||
row = row + 1
|
||
|
||
' 获取禁用自动降级的物料
|
||
Set materials = bomMgr.GetMaterialsByModel(modelStr, "部件", False)
|
||
|
||
If materials.Count = 0 Then
|
||
wsCompare.Cells(row, 1).value = "(无物料 - 因为禁用降级)"
|
||
wsCompare.Cells(row, 2).value = "说明"
|
||
wsCompare.Cells(row, 3).value = "当父类别无匹配物料时,不会降级到子类别查找"
|
||
row = row + 1
|
||
Else
|
||
For i = 1 To materials.Count
|
||
Set mat = materials(i)
|
||
wsCompare.Cells(row, 1).value = mat.Category
|
||
wsCompare.Cells(row, 2).value = mat.code
|
||
wsCompare.Cells(row, 3).value = mat.Name
|
||
wsCompare.Cells(row, 4).value = mat.Quantity
|
||
wsCompare.Cells(row, 5).value = IIf(mat.Condition = "", "(无)", mat.Condition)
|
||
row = row + 1
|
||
Next i
|
||
End If
|
||
|
||
' 添加说明
|
||
row = row + 1
|
||
wsCompare.Cells(row, 1).value = "说明:"
|
||
wsCompare.Cells(row, 1).Font.Bold = True
|
||
row = row + 1
|
||
wsCompare.Cells(row, 1).value = "?? autoFallback=True (默认): 当""部件""类别无匹配物料时,自动降级到子类别""接头""、""弹性元件""等查找"
|
||
row = row + 1
|
||
wsCompare.Cells(row, 1).value = "?? autoFallback=False: 仅在""部件""类别查找,即使有子类别也不降级,可能返回空集合"
|
||
|
||
' 格式化
|
||
wsCompare.Columns("A:E").AutoFit
|
||
wsCompare.Range("A1").Font.Bold = True
|
||
|
||
MsgBox "降级模式对比完成！" & vbCrLf & _
|
||
"请查看工作表: 降级模式对比" & vbCrLf & vbCrLf & _
|
||
"启用降级: " & bomMgr.GetMaterialsByModel(modelStr, "部件", True).Count & " 个物料" & vbCrLf & _
|
||
"禁用降级: " & bomMgr.GetMaterialsByModel(modelStr, "部件", False).Count & " 个物料", _
|
||
vbInformation
|
||
End Sub
|
||
|
||
' ========================================
|
||
' 示例7: 测试GetValidMaterialsByModel方法 (使用内置的缺失列表)
|
||
' ⭐ v2.0 更新：使用新的 LoadData(wsPlatform) 接口
|
||
' 完整性检查使用"类别选用条件"动态判断需要的类别
|
||
' ========================================
|
||
Sub Example7_TestGetValidMaterialsByModel()
|
||
Dim bomMgr As New clsBOMManager
|
||
Dim wsPlatform As Worksheet
|
||
|
||
' 加载配置
|
||
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
|
||
bomMgr.LoadData wsPlatform
|
||
|
||
' 创建测试结果工作表
|
||
Dim wsTest As Worksheet
|
||
On Error Resume Next
|
||
Application.DisplayAlerts = False
|
||
ThisWorkbook.Worksheets("物料完整性测试").Delete
|
||
Application.DisplayAlerts = True
|
||
On Error GoTo 0
|
||
|
||
Set wsTest = ThisWorkbook.Worksheets.Add
|
||
wsTest.Name = "物料完整性测试"
|
||
|
||
' 写入标题
|
||
Dim row As Long
|
||
row = 1
|
||
wsTest.Cells(row, 1).value = "物料完整性测试报告"
|
||
wsTest.Cells(row, 1).Font.Bold = True
|
||
wsTest.Cells(row, 1).Font.Size = 14
|
||
row = row + 2
|
||
|
||
' 定义测试型号
|
||
Dim testModels() As Variant
|
||
testModels = Array( _
|
||
Array("YTHN-100.A0.532.M203.M16.Y3|BP-095.2312.M16.PA3", "完整型号测试1"), _
|
||
Array("YTHN-100.A0.532.M203.M17.Y3", "缺失子类别测试") _
|
||
)
|
||
|
||
Dim i As Long
|
||
For i = LBound(testModels) To UBound(testModels)
|
||
Dim modelStr As String
|
||
Dim testName As String
|
||
modelStr = testModels(i)(0)
|
||
testName = testModels(i)(1)
|
||
|
||
' 1. 调用方法获取结果
|
||
Dim result As collection
|
||
Set result = bomMgr.GetValidMaterialsByModel(modelStr)
|
||
|
||
Dim materials As collection
|
||
Dim missingCats As collection
|
||
Dim isComplete As Boolean
|
||
|
||
Set materials = result("Materials")
|
||
Set missingCats = result("MissingCategories") ' 直接获取缺失列表
|
||
isComplete = result("IsComplete")
|
||
|
||
' 2. 写入头部信息
|
||
wsTest.Cells(row, 1).value = "测试 " & (i + 1) & ": " & testName
|
||
wsTest.Cells(row, 1).Font.Bold = True
|
||
wsTest.Cells(row, 1).Interior.Color = RGB(240, 240, 240)
|
||
row = row + 1
|
||
|
||
wsTest.Cells(row, 1).value = "型号:"
|
||
wsTest.Cells(row, 2).value = modelStr
|
||
row = row + 1
|
||
|
||
wsTest.Cells(row, 1).value = "完整性:"
|
||
wsTest.Cells(row, 2).value = IIf(isComplete, "?? 完整", "?? 不完整")
|
||
If isComplete Then
|
||
wsTest.Cells(row, 2).Font.Color = RGB(0, 128, 0)
|
||
Else
|
||
wsTest.Cells(row, 2).Font.Color = RGB(255, 0, 0)
|
||
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 = "名称"
|
||
wsTest.Cells(row, 4).value = "数量"
|
||
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
|
||
For Each mat In materials
|
||
wsTest.Cells(row, 1).value = mat.Category
|
||
wsTest.Cells(row, 2).value = mat.code
|
||
wsTest.Cells(row, 3).value = mat.Name
|
||
wsTest.Cells(row, 4).value = mat.Quantity
|
||
row = row + 1
|
||
Next mat
|
||
Else
|
||
wsTest.Cells(row, 1).value = "(无)"
|
||
row = row + 1
|
||
End If
|
||
|
||
' 4. 打印缺失的类别 (新增核心功能)
|
||
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).Font.Color = RGB(255, 0, 0)
|
||
wsTest.Cells(row, 2).value = "未找到匹配物料"
|
||
row = row + 1
|
||
Next catName
|
||
End If
|
||
|
||
' 添加分隔行
|
||
row = row + 1
|
||
wsTest.Cells(row, 1).value = String(80, "-")
|
||
row = row + 2
|
||
Next i
|
||
|
||
wsTest.Columns("A:D").AutoFit
|
||
MsgBox "测试完成！", vbInformation
|
||
End Sub
|
||
|
||
' ========================================
|
||
' 示例8: 批量处理产品订单，生成物料清单
|
||
' ⭐ v2.0 更新：使用新的 LoadData(wsPlatform) 接口
|
||
' ========================================
|
||
Sub Example8_BatchProcessOrders()
|
||
Dim bomMgr As New clsBOMManager
|
||
Dim wsPlatform As Worksheet
|
||
Dim wsOrders As Worksheet
|
||
Dim wsOutput As Worksheet
|
||
|
||
' 加载配置
|
||
On Error Resume Next
|
||
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
|
||
Set wsOrders = ThisWorkbook.Worksheets("产品订单")
|
||
|
||
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 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清单
|
||
'
|
||
' ⭐ v2.0 更新：
|
||
' - 移除 [领料配置] 表依赖
|
||
' - 使用新的 LoadData(wsPlatform) 接口（单参数）
|
||
' - 完整性检查使用"类别选用条件"动态判断需要的类别
|
||
' ========================================
|
||
Sub Example9_BatchProcessOrders_WithCheck()
|
||
Dim bomMgr As New clsBOMManager
|
||
Dim wsPlatform As Worksheet, wsOrders As Worksheet, wsOutput As Worksheet
|
||
Dim parser As clsModelParser
|
||
Dim extractor As clsConditionExtractor
|
||
|
||
' 1. 初始化与加载数据
|
||
On Error Resume Next
|
||
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
|
||
Set wsOrders = ThisWorkbook.Worksheets("产品订单")
|
||
On Error GoTo 0
|
||
|
||
If wsPlatform Is Nothing Or wsOrders Is Nothing Then
|
||
MsgBox "错误：缺少必要的工作表 (平台配置清单/产品订单)", vbCritical
|
||
Exit Sub
|
||
End If
|
||
|
||
' ⭐ 使用新接口：只需要一个参数
|
||
bomMgr.LoadData 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 |