fix: update modules to use new LoadData interface and fix completeness check logic

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>
This commit is contained in:
Misaka_Company
2026-01-29 12:38:50 +08:00
parent a9b3188d23
commit c9cf84ed4d
4 changed files with 82 additions and 73 deletions

View File

@@ -806,7 +806,10 @@ Public Function GetValidMaterialsByModel(modelStr As String) As collection
Dim requiredCats As collection
Set requiredCats = GetRequiredCategories(conditions)
' ⭐ 第二步: 只检查需要的类别的完整性
' ⭐ 第二步: 只检查需要的类别的完整性
' 说明: 不检查所有需要的类别,而是只检查根类别
' 因为 CheckCategoryCompleteness 会递归检查子类别
' 如果检查所有类别(包括子类别),会导致重复检查和重复添加到 missingCats
isComplete = True
Dim reqCat As clsCategory
@@ -814,9 +817,13 @@ Public Function GetValidMaterialsByModel(modelStr As String) As collection
For i = 1 To requiredCats.Count
Set reqCat = requiredCats(i)
' 检查类别及其子类别的完整性
Dim catResult As Object
Set catResult = CheckCategoryCompleteness(reqCat, matcher, conditions)
' ⭐ 关键修正: 只检查类别(无父类别的类别)
' "部件""接头""弹性元件"
'
If reqCat.ParentCategoryName = "" Then
' 检查该根类别及其所有子类别的完整性
Dim catResult As Object
Set catResult = CheckCategoryCompleteness(reqCat, matcher, conditions)
' 1.
Dim mat As clsMaterialItem
@@ -826,18 +833,19 @@ Public Function GetValidMaterialsByModel(modelStr As String) As collection
allMaterials.Add mat
Next mat
' 2.
Dim missingCollection As collection
Set missingCollection = catResult("Missing")
Dim missingCatName As Variant
For Each missingCatName In missingCollection
allMissingCats.Add missingCatName
Next missingCatName
' 2.
Dim missingCollection As collection
Set missingCollection = catResult("Missing")
Dim missingCatName As Variant
For Each missingCatName In missingCollection
allMissingCats.Add missingCatName
Next missingCatName
' 3.
If Not catResult("IsComplete") Then
isComplete = False
End If
' 3.
If Not catResult("IsComplete") Then
isComplete = False
End If
End If ' If reqCat.ParentCategoryName = ""
Next i
'
@@ -914,13 +922,17 @@ Private Function CheckCategoryCompleteness(cat As clsCategory, _
Else
' ========================================
' 情况2: 有子类别
' 完整性判断规则:
' - 方式一: 父类别有1个匹配物料 → 完整
' - 方式二: 父类别无匹配物料, 但所有子类别都完整 → 完整
' - 其他情况 → 不完整
' ========================================
If matchCount = 1 Then
' 父类别有且仅有1个物料, 使用父类别 -> 完整
' 方式一: 父类别有且仅有1个物料, 使用父类别 -> 完整
isComplete = True
' 不需要检查子类别了missingCats 保持为空
ElseIf matchCount = 0 Then
' 父类别无匹配物料, 必须降级检查所有子类别
' 方式二: 父类别无匹配物料, 必须降级检查所有子类别
' 清空当前物料集合(确保没东西), 准备收集子类别结果
Set materials = New collection
@@ -943,7 +955,7 @@ Private Function CheckCategoryCompleteness(cat As clsCategory, _
materials.Add subMaterials(k)
Next k
' b) ()
' b)
Dim subMissing As collection
Set subMissing = subResult("Missing")
Dim item As Variant
@@ -956,9 +968,14 @@ Private Function CheckCategoryCompleteness(cat As clsCategory, _
isComplete = False
End If
Next j
' ⭐ 关键修正: 如果所有子类别都完整, 父类别不应该被标记为缺失
' 只有当父类别是叶子类别且没有物料时, 才应该被标记为缺失
' 对于有子类别的父类别, 只要所有子类别都完整, 父类别就是完整的
Else
' 父类别有 >1 个匹配, 视为不完整(冲突)
isComplete = False
' 父类别有多个匹配, 这种情况下不应该标记为缺失(而是配置错误)
End If
End If

View File

@@ -1,6 +1,7 @@
' ========================================
' 模块: modBOMTest
' 用途: 测试和使用BOM数据结构
' 模块: modBOMProcessor
' 用途: BOM处理和操作示例
' ⭐ v2.0 更新:所有过程使用新的 LoadData(wsPlatform) 接口
' ========================================
Option Explicit
@@ -8,15 +9,12 @@ Sub TestBOMStructure()
' 初始化BOM管理器
Dim bomMgr As New clsBOMManager
' 加载数据(假设工作表名称)
Dim wsConfig As Worksheet
' 加载数据
Dim wsPlatform As Worksheet
Set wsConfig = ThisWorkbook.Worksheets("领料配置")
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
' 加载数据
bomMgr.LoadData wsConfig, wsPlatform
' ⭐ 使用新接口
bomMgr.LoadData wsPlatform
' 打印类别树结构到新工作表
Dim wsOutput As Worksheet
@@ -47,12 +45,12 @@ End Sub
' 示例: 获取特定类别的物料
Sub GetCategoryMaterials()
Dim bomMgr As New clsBOMManager
Dim wsConfig As Worksheet, wsPlatform As Worksheet
Dim wsPlatform As Worksheet
Set wsConfig = ThisWorkbook.Worksheets("领料配置")
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
bomMgr.LoadData wsConfig, wsPlatform
' ⭐ 使用新接口
bomMgr.LoadData wsPlatform
' 获取"部件"类别的物料(使用父类别)
Dim materials As collection
@@ -77,12 +75,12 @@ End Sub
' 示例: 根据产品型号生成领料清单
Sub GeneratePickingList()
Dim bomMgr As New clsBOMManager
Dim wsConfig As Worksheet, wsPlatform As Worksheet
Dim wsPlatform As Worksheet
Set wsConfig = ThisWorkbook.Worksheets("领料配置")
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
bomMgr.LoadData wsConfig, wsPlatform
' ⭐ 使用新接口
bomMgr.LoadData wsPlatform
' 创建领料清单工作表
Dim wsPickList As Worksheet
@@ -142,12 +140,12 @@ End Sub
' 示例: 查询特定物料信息
Sub QueryMaterialInfo()
Dim bomMgr As New clsBOMManager
Dim wsConfig As Worksheet, wsPlatform As Worksheet
Dim wsPlatform As Worksheet
Set wsConfig = ThisWorkbook.Worksheets("领料配置")
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
bomMgr.LoadData wsConfig, wsPlatform
' ⭐ 使用新接口
bomMgr.LoadData wsPlatform
' 查询特定类别
Dim cat As clsCategory

View File

@@ -6,16 +6,15 @@ Option Explicit
' ========================================
' 示例1: 根据型号生成完整的领料清单
' ⭐ v2.0 更新:使用新的 LoadData(wsPlatform) 接口
' ========================================
Sub Example1_GeneratePickingListByModel()
Dim bomMgr As New clsBOMManager
Dim wsConfig As Worksheet
Dim wsPlatform As Worksheet
' 加载配置
Set wsConfig = ThisWorkbook.Worksheets("领料配置")
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
bomMgr.LoadData wsConfig, wsPlatform
bomMgr.LoadData wsPlatform
' 产品型号
Dim modelStr As String
@@ -101,16 +100,15 @@ End Sub
' ========================================
' 示例2: 批量处理多个型号
' ⭐ v2.0 更新:使用新的 LoadData(wsPlatform) 接口
' ========================================
Sub Example2_BatchProcessModels()
Dim bomMgr As New clsBOMManager
Dim wsConfig As Worksheet
Dim wsPlatform As Worksheet
' 加载配置
Set wsConfig = ThisWorkbook.Worksheets("领料配置")
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
bomMgr.LoadData wsConfig, wsPlatform
bomMgr.LoadData wsPlatform
' 型号列表
Dim models() As String
@@ -299,16 +297,15 @@ End Sub
' ========================================
' 示例5: 验证物料选择条件的有效性
' ⭐ v2.0 更新:使用新的 LoadData(wsPlatform) 接口
' ========================================
Sub Example5_ValidateMaterialConditions()
Dim bomMgr As New clsBOMManager
Dim wsConfig As Worksheet
Dim wsPlatform As Worksheet
' 加载配置
Set wsConfig = ThisWorkbook.Worksheets("领料配置")
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
bomMgr.LoadData wsConfig, wsPlatform
bomMgr.LoadData wsPlatform
' 创建验证结果表
Dim wsValidation As Worksheet
@@ -378,16 +375,15 @@ End Sub
' ========================================
' 示例6: 对比启用/禁用自动降级的效果
' ⭐ v2.0 更新:使用新的 LoadData(wsPlatform) 接口
' ========================================
Sub Example6_CompareAutoFallback()
Dim bomMgr As New clsBOMManager
Dim wsConfig As Worksheet
Dim wsPlatform As Worksheet
' 加载配置
Set wsConfig = ThisWorkbook.Worksheets("领料配置")
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
bomMgr.LoadData wsConfig, wsPlatform
bomMgr.LoadData wsPlatform
' 产品型号(使用可能导致类别缺失的型号)
Dim modelStr As String
@@ -503,16 +499,16 @@ End Sub
' ========================================
' 示例7: 测试GetValidMaterialsByModel方法 (使用内置的缺失列表)
' ⭐ v2.0 更新:使用新的 LoadData(wsPlatform) 接口
' 完整性检查使用"类别选用条件"动态判断需要的类别
' ========================================
Sub Example7_TestGetValidMaterialsByModel()
Dim bomMgr As New clsBOMManager
Dim wsConfig As Worksheet
Dim wsPlatform As Worksheet
' 加载配置
Set wsConfig = ThisWorkbook.Worksheets("领料配置")
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
bomMgr.LoadData wsConfig, wsPlatform
bomMgr.LoadData wsPlatform
' 创建测试结果工作表
Dim wsTest As Worksheet
@@ -635,24 +631,19 @@ End Sub
' ========================================
' 示例8: 批量处理产品订单,生成物料清单
' ⭐ v2.0 更新:使用新的 LoadData(wsPlatform) 接口
' ========================================
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
@@ -663,7 +654,7 @@ Sub Example8_BatchProcessOrders()
End If
On Error GoTo 0
bomMgr.LoadData wsConfig, wsPlatform
bomMgr.LoadData wsPlatform
' 读取订单数据
Dim lastRow As Long
@@ -808,28 +799,33 @@ End Sub
' 功能:
' 1. 提取型号条件
' 2. 校验模块数量如果是3个模块则报错
' 3. 校验类别完整性(如果缺失类别则报错)
' 3. 校验类别完整性(如果缺失类别则报错,使用类别选用条件判断
' 4. 生成BOM清单
'
' ⭐ v2.0 更新:
' - 移除 [领料配置] 表依赖
' - 使用新的 LoadData(wsPlatform) 接口(单参数)
' - 完整性检查使用"类别选用条件"动态判断需要的类别
' ========================================
Sub Example9_BatchProcessOrders_WithCheck()
Dim bomMgr As New clsBOMManager
Dim wsConfig As Worksheet, wsPlatform As Worksheet, wsOrders As Worksheet, wsOutput As Worksheet
Dim 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
If wsPlatform Is Nothing Or wsOrders Is Nothing Then
MsgBox "错误:缺少必要的工作表 (平台配置清单/产品订单)", vbCritical
Exit Sub
End If
bomMgr.LoadData wsConfig, wsPlatform
' ⭐ 使用新接口:只需要一个参数
bomMgr.LoadData wsPlatform
' 2. 准备输出容器
Dim outputData As collection

View File

@@ -173,20 +173,19 @@ Sub Test4_GetMaterialsByModel()
' 加载BOM数据
Dim bomMgr As New clsBOMManager
Dim wsConfig As Worksheet
Dim wsPlatform As Worksheet
On Error Resume Next
Set wsConfig = ThisWorkbook.Worksheets("领料配置")
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
On Error GoTo 0
If wsConfig Is Nothing Or wsPlatform Is Nothing Then
Debug.Print "? 错误: 找不到必需的工作表"
If wsPlatform Is Nothing Then
Debug.Print "? 错误: 找不到必需的工作表 [平台配置清单]"
Exit Sub
End If
bomMgr.LoadData wsConfig, wsPlatform
' ⭐ 使用新接口
bomMgr.LoadData wsPlatform
Debug.Print "? BOM数据加载完成"
Debug.Print ""
@@ -229,20 +228,19 @@ Sub Test5_GetAllMaterialsByModel()
' 加载BOM数据
Dim bomMgr As New clsBOMManager
Dim wsConfig As Worksheet
Dim wsPlatform As Worksheet
On Error Resume Next
Set wsConfig = ThisWorkbook.Worksheets("领料配置")
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
On Error GoTo 0
If wsConfig Is Nothing Or wsPlatform Is Nothing Then
Debug.Print "? 错误: 找不到必需的工作表"
If wsPlatform Is Nothing Then
Debug.Print "? 错误: 找不到必需的工作表 [平台配置清单]"
Exit Sub
End If
bomMgr.LoadData wsConfig, wsPlatform
' ⭐ 使用新接口
bomMgr.LoadData wsPlatform
' 测试型号
Dim modelStr As String