From 112a89a2a4df280a3d73c93ad3368199bdbfdbb8 Mon Sep 17 00:00:00 2001 From: Misaka_Company Date: Tue, 20 Jan 2026 18:13:11 +0800 Subject: [PATCH] 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. --- VBA/ClassModules/clsBOMManager.cls | 226 +++++++++++++++++++++++++ VBA/Modules/modModelParserExamples.bas | 152 +++++++++++++++++ 2 files changed, 378 insertions(+) diff --git a/VBA/ClassModules/clsBOMManager.cls b/VBA/ClassModules/clsBOMManager.cls index 7275a29..bdbda7a 100644 --- a/VBA/ClassModules/clsBOMManager.cls +++ b/VBA/ClassModules/clsBOMManager.cls @@ -681,4 +681,230 @@ Public Function ParseModelAndExtractConditions(modelStr As String) As Object End If Set ParseModelAndExtractConditions = conditions +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 \ No newline at end of file diff --git a/VBA/Modules/modModelParserExamples.bas b/VBA/Modules/modModelParserExamples.bas index 47d4a42..d27ec8f 100644 --- a/VBA/Modules/modModelParserExamples.bas +++ b/VBA/Modules/modModelParserExamples.bas @@ -499,4 +499,156 @@ Sub Example6_CompareAutoFallback() "启用降级: " & bomMgr.GetMaterialsByModel(modelStr, "部件", True).Count & " 个物料" & vbCrLf & _ "禁用降级: " & bomMgr.GetMaterialsByModel(modelStr, "部件", False).Count & " 个物料", _ vbInformation +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 \ No newline at end of file