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

feat: track and return missing material categories in BOM

Browse Source 
- 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
Download Patch File Download Diff File Expand all files Collapse all files

90
VBA/ClassModules/clsBOMManager.cls
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

106
VBA/Modules/modModelParserExamples.bas
View File

@@ -502,7 +502,7 @@ Sub Example6_CompareAutoFallback()
End Sub
' ========================================
' 示例7: 测试GetValidMaterialsByModel方法
' 示例7: 测试GetValidMaterialsByModel方法 (使用内置的缺失列表)
' ========================================
Sub Example7_TestGetValidMaterialsByModel()
Dim bomMgr As New clsBOMManager
@@ -533,13 +533,11 @@ Sub Example7_TestGetValidMaterialsByModel()
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.M02.Y3|BP-095.2312.M02.PA3", "完整型号测试2"), _
Array("YTHN-100.A0.532.M203.M12.Y3|BP-095.2312.M12.PA3", "完整型号测试3"), _
Array("YTHN-100.A0.532.M203.M17.Y3", "可能不完整的型号") _
Array("YTHN-100.A0.532.M203.M17.Y3", "缺失子类别测试") _
)
Dim i As Long
@@ -549,18 +547,22 @@ Sub Example7_TestGetValidMaterialsByModel()
modelStr = testModels(i)(0)
testName = testModels(i)(1)
' 调用GetValidMaterialsByModel
' 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 = "型号:"
@@ -568,41 +570,58 @@ 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) ' 绿色
wsTest.Cells(row, 2).Font.Color = RGB(0, 128, 0)
Else
wsTest.Cells(row, 2).Font.Color = RGB(255, 0, 0) ' 红色
wsTest.Cells(row, 2).Font.Color = RGB(255, 0, 0)
End If
wsTest.Cells(row, 2).Font.Bold = True
row = row + 1
wsTest.Cells(row, 1).value = "物料数量:"
wsTest.Cells(row, 2).value = materials.count
' 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.Cells(row, 5).value = "选择条件"
wsTest.Range(wsTest.Cells(row, 1), wsTest.Cells(row, 5)).Font.Bold = True
wsTest.Range(wsTest.Cells(row, 1), wsTest.Cells(row, 5)).Interior.Color = RGB(200, 200, 200)
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
Dim j As Long
For j = 1 To materials.count
Set mat = materials(j)
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
wsTest.Cells(row, 5).value = IIf(mat.Condition = "", "(无条件)", mat.Condition)
row = row + 1
Next j
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
@@ -610,45 +629,6 @@ Sub Example7_TestGetValidMaterialsByModel()
row = row + 2
Next i
' 添加统计汇总
wsTest.Cells(row, 1).value = "测试汇总"
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
wsTest.Columns("A:D").AutoFit
MsgBox "测试完成！", vbInformation
End Sub

2876
VBA/combined_output.md Normal file
View File

File diff suppressed because it is too large Load Diff