From 388ccc4e7a7ff971f9d7529d0954caf5d261c15e Mon Sep 17 00:00:00 2001 From: Misaka_Company Date: Tue, 20 Jan 2026 15:31:43 +0800 Subject: [PATCH] refactor: add subcategory fallback logic for material filtering Refactored the material retrieval logic in GetMaterialsByModel to automatically search within subcategories if no matches are found in the specified parent category. - Added FilterCategoryWithSubcategories helper function to handle recursive searching and fallback logic. - Restructured main function to delegate filtering to the new helper. - Enhanced code comments to clarify the step-by-step matching process. --- VBA/ClassModules/clsBOMManager.cls | 138 ++++++++++++++++++++----- VBA/Modules/modModelParserExamples.bas | 6 +- 2 files changed, 117 insertions(+), 27 deletions(-) diff --git a/VBA/ClassModules/clsBOMManager.cls b/VBA/ClassModules/clsBOMManager.cls index a601dc1..29bd72e 100644 --- a/VBA/ClassModules/clsBOMManager.cls +++ b/VBA/ClassModules/clsBOMManager.cls @@ -406,7 +406,9 @@ Public Function GetMaterialsByModel(modelStr As String, _ Dim result As collection Set result = New collection - ' 1. 解析型号 + ' ======================================== + ' 第1步: 解析型号并提取条件 + ' ======================================== Dim parser As New clsModelParser If Not parser.ParseModel(modelStr) Then Debug.Print "型号解析失败: " & parser.ErrorMessage @@ -414,7 +416,6 @@ Public Function GetMaterialsByModel(modelStr As String, _ Exit Function End If - ' 2. 提取条件 Dim extractor As New clsConditionExtractor Dim conditions As Object Set conditions = extractor.ExtractConditions(parser) @@ -428,55 +429,142 @@ Public Function GetMaterialsByModel(modelStr As String, _ Next key Debug.Print "" - ' 3. 创建条件匹配器 + ' ======================================== + ' 第2步: 按类别筛选物料（自动降级到子类别） + ' ======================================== Dim matcher As New clsConditionMatcher - - ' 4. 获取要筛选的物料范围 - Dim materialsToFilter As collection - Set materialsToFilter = New collection + Dim totalMatchCount As Long + Dim catResult As collection ' 提前声明，避免在If/Else中重复声明 + Dim cat As clsCategory + Dim rootCat As clsCategory + Dim i As Long, j As Long + totalMatchCount = 0 If categoryName <> "" Then - ' 指定类别：获取该类别的所有物料 - Dim cat As clsCategory + ' ======================================== + ' 情况A: 指定了类别名称 + ' 只在该类别及其子类别中查找 + ' ======================================== Set cat = GetCategory(categoryName) + If Not cat Is Nothing Then - Dim i As Long - For i = 1 To cat.materials.Count - materialsToFilter.Add cat.materials(i) + ' 从该类别开始查找（包含子类别降级逻辑） + Set catResult = FilterCategoryWithSubcategories(cat, matcher, conditions) + + ' 合并结果 + For i = 1 To catResult.Count + result.Add catResult(i) Next i + totalMatchCount = catResult.Count End If Else - ' 未指定类别：获取所有根类别的物料 - Dim rootCat As clsCategory - Dim j As Long + ' ======================================== + ' 情况B: 未指定类别名称 + ' 遍历所有根类别，对每个类别应用子类别降级逻辑 + ' ======================================== For j = 1 To rootCategories.Count Set rootCat = rootCategories(j) - ' 递归获取所有物料 - Call CollectAllMaterials(rootCat, materialsToFilter) + + ' 对每个根类别应用筛选（包含子类别降级逻辑） + Set catResult = FilterCategoryWithSubcategories(rootCat, matcher, conditions) + + ' 合并结果 + For i = 1 To catResult.Count + result.Add catResult(i) + Next i + totalMatchCount = totalMatchCount + catResult.Count Next j End If - ' 5. 筛选符合条件的物料 + Debug.Print "共匹配 " & totalMatchCount & " 个物料" + Debug.Print String(60, "=") + + Set GetMaterialsByModel = result +End Function + +' ======================================== +' FilterCategoryWithSubcategories 方法 (私有) +' 功能: 对指定类别进行筛选，如果无匹配则自动降级到子类别 +' 参数: +' cat - 类别对象 +' matcher - 条件匹配器对象 +' conditions - 提取的条件字典 +' 返回: Collection对象，包含匹配的物料 +' +' 工作逻辑: +' 1. 先尝试在当前类别下筛选物料 +' 2. 如果当前类别有匹配结果，直接返回 +' 3. 如果当前类别无匹配结果，检查是否有子类别 +' 4. 如果有子类别，递归对所有子类别进行筛选 +' 5. 如果无子类别，返回空集合 +' +' 示例场景: +' 型号: "YTHN-100.A0.532.M203.M16.Y3" +' 类别"部件"下有物料"低压接头部件"（条件: lcfw=M02） +' 如果该型号的量程不是M02，则"部件"类别无匹配 +' 此时自动降级到子类别"接头"、"弹性元件"等查找 +' ======================================== +Private Function FilterCategoryWithSubcategories(ByVal cat As clsCategory, _ + ByVal matcher As clsConditionMatcher, _ + ByVal conditions As Object) As collection + Dim result As collection + Set result = New collection + + ' 类别不存在，返回空集合 + If cat Is Nothing Then + Set FilterCategoryWithSubcategories = result + Exit Function + End If + + ' ======================================== + ' 第一阶段: 尝试在当前类别下筛选 + ' ======================================== Dim mat As clsMaterialItem + Dim i As Long Dim matchCount As Long matchCount = 0 - For Each mat In materialsToFilter - ' 使用条件匹配器判断 + ' 遍历当前类别的所有物料进行筛选 + For i = 1 To cat.materials.Count + Set mat = cat.materials(i) If matcher.IsMatch(mat.Condition, conditions) Then result.Add mat matchCount = matchCount + 1 ' 调试输出 - Debug.Print "【匹配】 " & mat.code & " - " & mat.Name & _ + Debug.Print "【匹配】" & cat.categoryName & " > " & _ + mat.code & " - " & mat.Name & _ " | 条件: " & IIf(mat.Condition = "", "(无)", mat.Condition) End If - Next mat + Next i - Debug.Print "共匹配 " & matchCount & " 个物料" - Debug.Print String(60, "=") + ' ======================================== + ' 第二阶段: 如果当前类别无匹配，检查子类别 + ' ======================================== + If matchCount = 0 And cat.HasSubCategories Then + Debug.Print "【降级】类别 """ & cat.categoryName & """ 无匹配物料，降级到子类别查找..." - Set GetMaterialsByModel = result + ' 递归处理所有子类别 + Dim subCat As clsCategory + Dim j As Long + For j = 1 To cat.SubCategories.Count + Set subCat = cat.SubCategories(j) + + ' 递归调用，获取子类别的匹配结果 + Dim subResult As collection + Set subResult = FilterCategoryWithSubcategories(subCat, matcher, conditions) + + ' 合并子类别的结果 + Dim k As Long + For k = 1 To subResult.Count + result.Add subResult(k) + Next k + Next j + ElseIf matchCount > 0 Then + Debug.Print "【成功】类别 """ & cat.categoryName & """ 匹配 " & matchCount & " 个物料" + End If + + Set FilterCategoryWithSubcategories = result End Function ' ======================================== diff --git a/VBA/Modules/modModelParserExamples.bas b/VBA/Modules/modModelParserExamples.bas index ccec110..1aed096 100644 --- a/VBA/Modules/modModelParserExamples.bas +++ b/VBA/Modules/modModelParserExamples.bas @@ -80,12 +80,14 @@ Sub Example1_GeneratePickingListByModel() Dim j As Long For j = 1 To materials.Count Set mat = materials(j) - wsPickList.Cells(row, 1).value = cat.categoryName + ' 使用物料自己的Category属性，而不是外层循环的类别名称 + ' 这样当GetMaterialsByModel降级到子类别查找时，能正确显示子类别名称 + wsPickList.Cells(row, 1).value = mat.Category wsPickList.Cells(row, 2).value = mat.code wsPickList.Cells(row, 3).value = mat.Name wsPickList.Cells(row, 4).value = mat.Quantity wsPickList.Cells(row, 5).value = IIf(mat.Condition = "", "(无条件)", mat.Condition) - wsPickList.Cells(row, 6).value = "?" + wsPickList.Cells(row, 6).value = "✓" row = row + 1 Next j Next i