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

View File

@@ -502,7 +502,7 @@ Sub Example6_CompareAutoFallback()
End Sub End Sub
' ======================================== ' ========================================
' 示例7: 测试GetValidMaterialsByModel方法 ' 示例7: 测试GetValidMaterialsByModel方法 (使用内置的缺失列表)
' ======================================== ' ========================================
Sub Example7_TestGetValidMaterialsByModel() Sub Example7_TestGetValidMaterialsByModel()
Dim bomMgr As New clsBOMManager Dim bomMgr As New clsBOMManager
@@ -533,13 +533,11 @@ Sub Example7_TestGetValidMaterialsByModel()
wsTest.Cells(row, 1).Font.Size = 14 wsTest.Cells(row, 1).Font.Size = 14
row = row + 2 row = row + 2
' 测试多个型号 ' 定义测试型号
Dim testModels() As Variant Dim testModels() As Variant
testModels = Array( _ testModels = Array( _
Array("YTHN-100.A0.532.M203.M16.Y3|BP-095.2312.M16.PA3", "完整型号测试1"), _ Array("YTHN-100.A0.532.M203.M16.Y3|BP-095.2312.M16.PA3", "完整型号测试1"), _
Array("YTHN-100.A0.532.M203.M02.Y3|BP-095.2312.M02.PA3", "完整型号测试2"), _ Array("YTHN-100.A0.532.M203.M17.Y3", "缺失子类别测试") _
Array("YTHN-100.A0.532.M203.M12.Y3|BP-095.2312.M12.PA3", "完整型号测试3"), _
Array("YTHN-100.A0.532.M203.M17.Y3", "可能不完整的型号") _
) )
Dim i As Long Dim i As Long
@@ -549,18 +547,22 @@ Sub Example7_TestGetValidMaterialsByModel()
modelStr = testModels(i)(0) modelStr = testModels(i)(0)
testName = testModels(i)(1) testName = testModels(i)(1)
' 调用GetValidMaterialsByModel ' 1. 调用方法获取结果
Dim result As collection Dim result As collection
Set result = bomMgr.GetValidMaterialsByModel(modelStr) Set result = bomMgr.GetValidMaterialsByModel(modelStr)
Dim materials As collection Dim materials As collection
Dim missingCats As collection
Dim isComplete As Boolean Dim isComplete As Boolean
Set materials = result("Materials") Set materials = result("Materials")
Set missingCats = result("MissingCategories") ' 直接获取缺失列表
isComplete = result("IsComplete") isComplete = result("IsComplete")
' 写入测试名称和型号 ' 2. 写入头部信息
wsTest.Cells(row, 1).value = "测试 " & (i + 1) & ": " & testName wsTest.Cells(row, 1).value = "测试 " & (i + 1) & ": " & testName
wsTest.Cells(row, 1).Font.Bold = True wsTest.Cells(row, 1).Font.Bold = True
wsTest.Cells(row, 1).Interior.Color = RGB(240, 240, 240)
row = row + 1 row = row + 1
wsTest.Cells(row, 1).value = "型号:" wsTest.Cells(row, 1).value = "型号:"
@@ -568,41 +570,58 @@ Sub Example7_TestGetValidMaterialsByModel()
row = row + 1 row = row + 1
wsTest.Cells(row, 1).value = "完整性:" wsTest.Cells(row, 1).value = "完整性:"
wsTest.Cells(row, 2).value = IIf(isComplete, "?? 完整", "?? 不完整") wsTest.Cells(row, 2).value = IIf(isComplete, " 完整", " 不完整")
If isComplete Then If isComplete Then
wsTest.Cells(row, 2).Font.Color = RGB(0, 128, 0) ' 绿色 wsTest.Cells(row, 2).Font.Color = RGB(0, 128, 0)
Else Else
wsTest.Cells(row, 2).Font.Color = RGB(255, 0, 0) ' 红色 wsTest.Cells(row, 2).Font.Color = RGB(255, 0, 0)
End If End If
wsTest.Cells(row, 2).Font.Bold = True wsTest.Cells(row, 2).Font.Bold = True
row = row + 1 row = row + 1
wsTest.Cells(row, 1).value = "物料数量:" ' 3. 打印匹配到的物料
wsTest.Cells(row, 2).value = materials.count wsTest.Cells(row, 1).value = "【已匹配物料】"
wsTest.Cells(row, 1).Font.Bold = True
row = row + 1 row = row + 1
' 写入物料明细表头
wsTest.Cells(row, 1).value = "类别" wsTest.Cells(row, 1).value = "类别"
wsTest.Cells(row, 2).value = "代号" wsTest.Cells(row, 2).value = "代号"
wsTest.Cells(row, 3).value = "名称" wsTest.Cells(row, 3).value = "名称"
wsTest.Cells(row, 4).value = "数量" wsTest.Cells(row, 4).value = "数量"
wsTest.Cells(row, 5).value = "选择条件" wsTest.Range(wsTest.Cells(row, 1), wsTest.Cells(row, 4)).Font.Bold = True
wsTest.Range(wsTest.Cells(row, 1), wsTest.Cells(row, 5)).Font.Bold = True wsTest.Range(wsTest.Cells(row, 1), wsTest.Cells(row, 4)).Interior.Color = RGB(220, 220, 220)
wsTest.Range(wsTest.Cells(row, 1), wsTest.Cells(row, 5)).Interior.Color = RGB(200, 200, 200)
row = row + 1 row = row + 1
' 写入每个物料
Dim mat As clsMaterialItem Dim mat As clsMaterialItem
Dim j As Long If materials.count > 0 Then
For j = 1 To materials.count For Each mat In materials
Set mat = materials(j) wsTest.Cells(row, 1).value = mat.Category
wsTest.Cells(row, 1).value = mat.Category wsTest.Cells(row, 2).value = mat.code
wsTest.Cells(row, 2).value = mat.code wsTest.Cells(row, 3).value = mat.Name
wsTest.Cells(row, 3).value = mat.Name wsTest.Cells(row, 4).value = mat.Quantity
wsTest.Cells(row, 4).value = mat.Quantity row = row + 1
wsTest.Cells(row, 5).value = IIf(mat.Condition = "", "(无条件)", mat.Condition) Next mat
Else
wsTest.Cells(row, 1).value = "(无)"
row = row + 1 row = row + 1
Next j 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 row = row + 1
@@ -610,45 +629,6 @@ Sub Example7_TestGetValidMaterialsByModel()
row = row + 2 row = row + 2
Next i Next i
' 添加统计汇总 wsTest.Columns("A:D").AutoFit
wsTest.Cells(row, 1).value = "测试汇总" MsgBox "测试完成!", vbInformation
wsTest.Cells(row, 1).Font.Bold = True
wsTest.Cells(row, 1).Font.Size = 12
row = row + 1
Dim completeCount As Long
Dim incompleteCount As Long
completeCount = 0
incompleteCount = 0
For i = LBound(testModels) To UBound(testModels)
modelStr = testModels(i)(0)
Set result = bomMgr.GetValidMaterialsByModel(modelStr)
If result("IsComplete") Then
completeCount = completeCount + 1
Else
incompleteCount = incompleteCount + 1
End If
Next i
wsTest.Cells(row, 1).value = "总测试数:"
wsTest.Cells(row, 2).value = UBound(testModels) - LBound(testModels) + 1
row = row + 1
wsTest.Cells(row, 1).value = "完整:"
wsTest.Cells(row, 2).value = completeCount
wsTest.Cells(row, 2).Font.Color = RGB(0, 128, 0)
row = row + 1
wsTest.Cells(row, 1).value = "不完整:"
wsTest.Cells(row, 2).value = incompleteCount
wsTest.Cells(row, 2).Font.Color = RGB(255, 0, 0)
' 格式化
wsTest.Columns("A:E").AutoFit
MsgBox "物料完整性测试完成!" & vbCrLf & _
"完整: " & completeCount & " 个" & vbCrLf & _
"不完整: " & incompleteCount & " 个" & vbCrLf & vbCrLf & _
"请查看工作表: 物料完整性测试", vbInformation
End Sub End Sub

2876
VBA/combined_output.md Normal file

File diff suppressed because it is too large Load Diff