feat: track and return missing material categories in BOM

- Update GetValidMaterialsByModel to aggregate and return missing
  category names under the "MissingCategories" key.
- Remove debug print statements and unused variables to improve
  code cleanliness.
- Enhance result visualization to display completeness status
  with color formatting and detailed material tables.
This commit is contained in:
Misaka_Company
2026-01-21 09:51:37 +08:00
parent 112a89a2a4
commit 40a9fe99f4
3 changed files with 2965 additions and 123 deletions

View File

@@ -692,6 +692,7 @@ End Function
' Collection中包含两个元素:
' (1) "Materials" - Collection, clsMaterialItem
' (2) "IsComplete" - Boolean,
' (3) "MissingCategories" - Collection,
'
' 完整性判断规则:
' - 对于每个需要领料的类别(顶层类别或其需要领取的子类别)
@@ -709,6 +710,7 @@ End Function
Public Function GetValidMaterialsByModel(modelStr As String) As collection
Dim result As New collection
Dim allMaterials As New collection
Dim allMissingCats As New collection ' 用于存储所有缺失的类别
Dim isComplete As Boolean
'
@@ -718,6 +720,7 @@ Public Function GetValidMaterialsByModel(modelStr As String) As collection
isComplete = False
result.Add allMaterials, "Materials"
result.Add isComplete, "IsComplete"
result.Add allMissingCats, "MissingCategories"
Set GetValidMaterialsByModel = result
Exit Function
End If
@@ -726,23 +729,11 @@ Public Function GetValidMaterialsByModel(modelStr As String) As collection
Dim conditions As Object
Set conditions = extractor.ExtractConditions(parser)
'
Debug.Print "【GetValidMaterialsByModel】"
Debug.Print "型号: " & modelStr
Debug.Print "提取的条件:"
Dim key As Variant
For Each key In conditions.Keys
Debug.Print " " & key & " = " & conditions(key)
Next key
Debug.Print ""
' 条件匹配器
Dim matcher As New clsConditionMatcher
' 遍历所有根类别,检查完整性
isComplete = True
Dim categoryCheckResults As Object
Set categoryCheckResults = CreateObject("Scripting.Dictionary")
Dim rootCat As clsCategory
Dim i As Long
@@ -753,7 +744,7 @@ Public Function GetValidMaterialsByModel(modelStr As String) As collection
Dim catResult As Object
Set catResult = CheckCategoryCompleteness(rootCat, matcher, conditions)
'
' 1.
Dim mat As clsMaterialItem
Dim matCollection As collection
Set matCollection = catResult("Materials")
@@ -761,29 +752,25 @@ 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
' 3.
If Not catResult("IsComplete") Then
isComplete = False
Debug.Print "【不完整】类别 """ & rootCat.categoryName & """ 物料不完整"
End If
' ()
categoryCheckResults(rootCat.categoryName) = catResult("IsComplete")
Next i
'
Debug.Print ""
Debug.Print "【完整性检查结果】"
Debug.Print "总物料数: " & allMaterials.count
Debug.Print "是否完整: " & IIf(isComplete, "是", "否")
For Each key In categoryCheckResults.Keys
Debug.Print " " & key & ": " & IIf(categoryCheckResults(key), "完整", "不完整")
Next key
Debug.Print String(60, "=")
'
result.Add allMaterials, "Materials"
result.Add isComplete, "IsComplete"
result.Add allMissingCats, "MissingCategories" ' 新增返回项
Set GetValidMaterialsByModel = result
End Function
@@ -797,6 +784,7 @@ End Function
' 返回: Dictionary对象
' "Materials" - Collection,
' "IsComplete" - Boolean,
' "Missing" - Collection,
'
' 完整性判断逻辑:
' 1. 如果类别没有子类别(叶子类别):
@@ -817,6 +805,7 @@ Private Function CheckCategoryCompleteness(cat As clsCategory, _
Set result = CreateObject("Scripting.Dictionary")
Dim materials As New collection
Dim missingCats As New collection ' 本层级及子层级缺失的类别
Dim isComplete As Boolean
' 首先在当前类别查找匹配的物料
@@ -837,36 +826,31 @@ Private Function CheckCategoryCompleteness(cat As clsCategory, _
If Not cat.HasSubCategories Then
' ========================================
' 情况1: 叶子类别(无子类别)
' 必须有且仅有1个物料
' ========================================
If matchCount = 1 Then
isComplete = True
Debug.Print "【完整】叶子类别 """ & cat.categoryName & """ 有1个匹配物料"
Else
isComplete = False
' 如果是叶子节点且没有匹配到物料,记录该类别为缺失
If matchCount = 0 Then
Debug.Print "【不完整】叶子类别 """ & cat.categoryName & """ 无匹配物料"
Else
Debug.Print "【不完整】叶子类别 """ & cat.categoryName & """ 有" & matchCount & "个匹配物料(应为1个)"
missingCats.Add cat.categoryName
End If
' : matchCount > 1 ()"Missing"
End If
Else
' ========================================
' 情况2: 有子类别
' 先检查父类别,如果父类别满足则使用父类别
' 否则降级到子类别,每个子类别都必须满足
' ========================================
If matchCount = 1 Then
' 1,使
' 父类别有且仅有1个物料, 使用父类别 -> 完整
isComplete = True
Debug.Print "【完整】父类别 """ & cat.categoryName & """ 有1个匹配物料,使用父类别"
' 不需要检查子类别了missingCats 保持为空
ElseIf matchCount = 0 Then
' ,
Debug.Print "【降级】父类别 """ & cat.categoryName & """ 无匹配物料,检查子类别..."
' 父类别无匹配物料, 必须降级检查所有子类别
' 清空物料集合,准备收集子类别物料
' 清空当前物料集合(确保没东西), 准备收集子类别结果
Set materials = New collection
isComplete = True ' 假设完整,如果任一子类别不完整则设为False
isComplete = True ' 假设完整,任一子类别不完整则置错
Dim subCat As clsCategory
Dim j As Long
@@ -877,7 +861,7 @@ Private Function CheckCategoryCompleteness(cat As clsCategory, _
Dim subResult As Object
Set subResult = CheckCategoryCompleteness(subCat, matcher, conditions)
'
' a)
Dim subMaterials As collection
Set subMaterials = subResult("Materials")
Dim k As Long
@@ -885,26 +869,28 @@ Private Function CheckCategoryCompleteness(cat As clsCategory, _
materials.Add subMaterials(k)
Next k
'
' b) ()
Dim subMissing As collection
Set subMissing = subResult("Missing")
Dim item As Variant
For Each item In subMissing
missingCats.Add item
Next item
' c)
If Not subResult("IsComplete") Then
isComplete = False
End If
Next j
If isComplete Then
Debug.Print "【完整】类别 """ & cat.categoryName & """ 所有子类别都完整"
Else
Debug.Print "【不完整】类别 """ & cat.categoryName & """ 存在不完整的子类别"
End If
Else
' ,
' 父类别有 >1 个匹配, 视为不完整(冲突)
isComplete = False
Debug.Print "【不完整】父类别 """ & cat.categoryName & """ 有" & matchCount & "个匹配物料(应为0或1个)"
End If
End If
'
'
Set result("Materials") = materials
result("IsComplete") = isComplete
Set result("Missing") = missingCats
Set CheckCategoryCompleteness = result
End Function
End Function