feat: Add GetValidMaterialsByModel and completeness check
Implemented logic to retrieve materials based on a model string and verify if the resulting set is complete. Added: - `GetValidMaterialsByModel`: Parses the model, extracts conditions, and matches materials against root categories. - `CheckCategoryCompleteness`: Recursively validates categories to ensure exactly one material match per required category (leaf or parent). This enables the BOM Manager to return a collection of materials alongside a boolean flag indicating if the collection satisfies the structural completeness rules.
This commit is contained in:
Misaka_Company
@@ -682,3 +682,229 @@ Public Function ParseModelAndExtractConditions(modelStr As String) As Object
|
|||||||
|
|
||||||
Set ParseModelAndExtractConditions = conditions
|
Set ParseModelAndExtractConditions = conditions
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
|
' ========================================
|
||||||
|
' GetValidMaterialsByModel 方法
|
||||||
|
' 功能: 根据产品型号获取物料，并判断是否为完整的物料集合
|
||||||
|
' 参数:
|
||||||
|
' modelStr - 产品型号字符串
|
||||||
|
' 返回: Collection对象
|
||||||
|
' Collection中包含两个元素:
|
||||||
|
' (1) "Materials" - Collection对象,包含所有匹配的 clsMaterialItem 对象
|
||||||
|
' (2) "IsComplete" - Boolean值,指示物料是否完整
|
||||||
|
'
|
||||||
|
' 完整性判断规则:
|
||||||
|
' - 对于每个需要领料的类别(顶层类别或其需要领取的子类别)
|
||||||
|
' - 必须有且仅有一个物料被匹配
|
||||||
|
' - 如果某个类别有0个或多于1个物料,则视为不完整
|
||||||
|
'
|
||||||
|
' 示例:
|
||||||
|
' Dim result As Collection
|
||||||
|
' Set result = bomMgr.GetValidMaterialsByModel("YTHN-100.A0.532.M203.M16.Y3")
|
||||||
|
' Dim materials As Collection
|
||||||
|
' Dim isComplete As Boolean
|
||||||
|
' Set materials = result("Materials")
|
||||||
|
' isComplete = result("IsComplete")
|
||||||
|
' ========================================
|
||||||
|
Public Function GetValidMaterialsByModel(modelStr As String) As collection
|
||||||
|
Dim result As New collection
|
||||||
|
Dim allMaterials As New collection
|
||||||
|
Dim isComplete As Boolean
|
||||||
|
|
||||||
|
' 解析型号并提取条件
|
||||||
|
Dim parser As New clsModelParser
|
||||||
|
If Not parser.ParseModel(modelStr) Then
|
||||||
|
Debug.Print "型号解析失败: " & parser.ErrorMessage
|
||||||
|
isComplete = False
|
||||||
|
result.Add allMaterials, "Materials"
|
||||||
|
result.Add isComplete, "IsComplete"
|
||||||
|
Set GetValidMaterialsByModel = result
|
||||||
|
Exit Function
|
||||||
|
End If
|
||||||
|
|
||||||
|
Dim extractor As New clsConditionExtractor
|
||||||
|
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
|
||||||
|
For i = 1 To rootCategories.count
|
||||||
|
Set rootCat = rootCategories(i)
|
||||||
|
|
||||||
|
' 检查该类别及其子类别的完整性
|
||||||
|
Dim catResult As Object
|
||||||
|
Set catResult = CheckCategoryCompleteness(rootCat, matcher, conditions)
|
||||||
|
|
||||||
|
' 合并物料
|
||||||
|
Dim mat As clsMaterialItem
|
||||||
|
Dim matCollection As collection
|
||||||
|
Set matCollection = catResult("Materials")
|
||||||
|
For Each mat In matCollection
|
||||||
|
allMaterials.Add mat
|
||||||
|
Next mat
|
||||||
|
|
||||||
|
' 检查完整性
|
||||||
|
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"
|
||||||
|
Set GetValidMaterialsByModel = result
|
||||||
|
End Function
|
||||||
|
|
||||||
|
' ========================================
|
||||||
|
' CheckCategoryCompleteness 方法 (私有)
|
||||||
|
' 功能: 检查单个类别的完整性(递归处理子类别)
|
||||||
|
' 参数:
|
||||||
|
' cat - 类别对象
|
||||||
|
' matcher - 条件匹配器
|
||||||
|
' conditions - 提取的条件字典
|
||||||
|
' 返回: Dictionary对象
|
||||||
|
' "Materials" - Collection,包含该类别匹配的物料
|
||||||
|
' "IsComplete" - Boolean,该类别是否完整
|
||||||
|
'
|
||||||
|
' 完整性判断逻辑:
|
||||||
|
' 1. 如果类别没有子类别(叶子类别):
|
||||||
|
' - 必须有且仅有1个物料匹配 → 完整
|
||||||
|
' - 0个或多于1个物料 → 不完整
|
||||||
|
'
|
||||||
|
' 2. 如果类别有子类别:
|
||||||
|
' a) 先尝试在父类别查找物料
|
||||||
|
' b) 如果父类别有且仅有1个匹配物料 → 使用父类别,完整
|
||||||
|
' c) 如果父类别没有匹配物料 → 降级到所有子类别
|
||||||
|
' - 每个子类别都必须有且仅有1个匹配物料 → 完整
|
||||||
|
' - 任一子类别不满足 → 不完整
|
||||||
|
' ========================================
|
||||||
|
Private Function CheckCategoryCompleteness(cat As clsCategory, _
|
||||||
|
matcher As clsConditionMatcher, _
|
||||||
|
conditions As Object) As Object
|
||||||
|
Dim result As Object
|
||||||
|
Set result = CreateObject("Scripting.Dictionary")
|
||||||
|
|
||||||
|
Dim materials As New collection
|
||||||
|
Dim isComplete As Boolean
|
||||||
|
|
||||||
|
' 首先在当前类别查找匹配的物料
|
||||||
|
Dim mat As clsMaterialItem
|
||||||
|
Dim matchCount As Long
|
||||||
|
matchCount = 0
|
||||||
|
|
||||||
|
Dim i As Long
|
||||||
|
For i = 1 To cat.materials.count
|
||||||
|
Set mat = cat.materials(i)
|
||||||
|
If matcher.IsMatch(mat.Condition, conditions) Then
|
||||||
|
materials.Add mat
|
||||||
|
matchCount = matchCount + 1
|
||||||
|
End If
|
||||||
|
Next i
|
||||||
|
|
||||||
|
' 判断完整性
|
||||||
|
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个)"
|
||||||
|
End If
|
||||||
|
End If
|
||||||
|
Else
|
||||||
|
' ========================================
|
||||||
|
' 情况2: 有子类别
|
||||||
|
' 先检查父类别,如果父类别满足则使用父类别
|
||||||
|
' 否则降级到子类别,每个子类别都必须满足
|
||||||
|
' ========================================
|
||||||
|
If matchCount = 1 Then
|
||||||
|
' 父类别有且仅有1个物料,使用父类别
|
||||||
|
isComplete = True
|
||||||
|
Debug.Print "【完整】父类别 """ & cat.categoryName & """ 有1个匹配物料,使用父类别"
|
||||||
|
ElseIf matchCount = 0 Then
|
||||||
|
' 父类别无匹配物料,降级到子类别
|
||||||
|
Debug.Print "【降级】父类别 """ & cat.categoryName & """ 无匹配物料,检查子类别..."
|
||||||
|
|
||||||
|
' 清空物料集合,准备收集子类别物料
|
||||||
|
Set materials = New collection
|
||||||
|
isComplete = True ' 假设完整,如果任一子类别不完整则设为False
|
||||||
|
|
||||||
|
Dim subCat As clsCategory
|
||||||
|
Dim j As Long
|
||||||
|
For j = 1 To cat.SubCategories.count
|
||||||
|
Set subCat = cat.SubCategories(j)
|
||||||
|
|
||||||
|
' 递归检查子类别
|
||||||
|
Dim subResult As Object
|
||||||
|
Set subResult = CheckCategoryCompleteness(subCat, matcher, conditions)
|
||||||
|
|
||||||
|
' 合并子类别物料
|
||||||
|
Dim subMaterials As collection
|
||||||
|
Set subMaterials = subResult("Materials")
|
||||||
|
Dim k As Long
|
||||||
|
For k = 1 To subMaterials.count
|
||||||
|
materials.Add subMaterials(k)
|
||||||
|
Next k
|
||||||
|
|
||||||
|
' 检查子类别是否完整
|
||||||
|
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
|
||||||
|
' 父类别有多个匹配物料,不完整
|
||||||
|
isComplete = False
|
||||||
|
Debug.Print "【不完整】父类别 """ & cat.categoryName & """ 有" & matchCount & "个匹配物料(应为0或1个)"
|
||||||
|
End If
|
||||||
|
End If
|
||||||
|
|
||||||
|
' 返回结果
|
||||||
|
Set result("Materials") = materials
|
||||||
|
result("IsComplete") = isComplete
|
||||||
|
Set CheckCategoryCompleteness = result
|
||||||
|
End Function
|
||||||
@@ -500,3 +500,155 @@ Sub Example6_CompareAutoFallback()
|
|||||||
"禁用降级: " & bomMgr.GetMaterialsByModel(modelStr, "部件", False).Count & " 个物料", _
|
"禁用降级: " & bomMgr.GetMaterialsByModel(modelStr, "部件", False).Count & " 个物料", _
|
||||||
vbInformation
|
vbInformation
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
|
' ========================================
|
||||||
|
' 示例7: 测试GetValidMaterialsByModel方法
|
||||||
|
' ========================================
|
||||||
|
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
|
||||||
|
|
||||||
|
' 创建测试结果工作表
|
||||||
|
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.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", "可能不完整的型号") _
|
||||||
|
)
|
||||||
|
|
||||||
|
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)
|
||||||
|
|
||||||
|
' 调用GetValidMaterialsByModel
|
||||||
|
Dim result As collection
|
||||||
|
Set result = bomMgr.GetValidMaterialsByModel(modelStr)
|
||||||
|
|
||||||
|
Dim materials As collection
|
||||||
|
Dim isComplete As Boolean
|
||||||
|
Set materials = result("Materials")
|
||||||
|
isComplete = result("IsComplete")
|
||||||
|
|
||||||
|
' 写入测试名称和型号
|
||||||
|
wsTest.Cells(row, 1).value = "测试 " & (i + 1) & ": " & testName
|
||||||
|
wsTest.Cells(row, 1).Font.Bold = True
|
||||||
|
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
|
||||||
|
|
||||||
|
wsTest.Cells(row, 1).value = "物料数量:"
|
||||||
|
wsTest.Cells(row, 2).value = materials.count
|
||||||
|
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)
|
||||||
|
row = row + 1
|
||||||
|
|
||||||
|
' 写入每个物料
|
||||||
|
Dim mat As clsMaterialItem
|
||||||
|
Dim j As Long
|
||||||
|
For j = 1 To materials.count
|
||||||
|
Set mat = materials(j)
|
||||||
|
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
|
||||||
|
|
||||||
|
' 添加分隔行
|
||||||
|
row = row + 1
|
||||||
|
wsTest.Cells(row, 1).value = String(80, "-")
|
||||||
|
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
|
||||||
|
End Sub
|
||||||
Reference in New Issue
Block a user