From f3fc5b4cbde68ff90a03e1b070525c45e2b5e372 Mon Sep 17 00:00:00 2001 From: Misaka_Company Date: Tue, 20 Jan 2026 16:24:49 +0800 Subject: [PATCH] feat(clsBOMManager): add optional autoFallback param Added the `autoFallback` optional parameter to `GetMaterialsByModel`. This flag controls whether the search automatically descends to subcategories when no matches are found in the target category. - Defaults to True to maintain previous recursive behavior. - When False, the search is restricted strictly to the specified category. - Updated documentation with usage examples and logic explanations. --- VBA/ClassModules/clsBOMManager.cls | 65 +++++++++---- VBA/Modules/modModelParserExamples.bas | 125 +++++++++++++++++++++++++ 2 files changed, 171 insertions(+), 19 deletions(-) diff --git a/VBA/ClassModules/clsBOMManager.cls b/VBA/ClassModules/clsBOMManager.cls index 29bd72e..7275a29 100644 --- a/VBA/ClassModules/clsBOMManager.cls +++ b/VBA/ClassModules/clsBOMManager.cls @@ -377,6 +377,15 @@ End Sub ' 指定类别名: 仅返回该类别下的符合条件物料 ' 示例: "部件"、"表壳"、"接头"、"机芯" ' +' autoFallback - 是否自动降级到子类别(可选参数,默认为True) +' True (默认): 当某个类别无匹配物料时,自动降级到其子类别继续查找 +' False: 仅在当前类别查找,不降级到子类别 +' 示例场景: +' 型号 "YTHN-100.A0.532.M203.M17.Y3" 的量程是M17 +' 类别"部件"下的物料条件是 "lcfw=M02" +' autoFallback=True: 自动降级到子类别"接头"、"弹性元件"等查找 +' autoFallback=False: "部件"类别返回空集合 +' ' 【返回值】 ' 返回类型: Collection对象 ' 元素类型: Collection中的每个元素都是 clsMaterialItem 对象 @@ -395,6 +404,9 @@ End Sub ' 3. 返回的Collection可能为空(没有符合条件的物料),需要判断Count属性 ' 4. 调试信息会输出到VBA的"立即窗口"(Ctrl+G查看) ' 5. 物料的Condition属性为空表示该物料无条件限制(所有型号都使用) +' 6. autoFallback 参数影响查找范围: +' - True (默认): 会返回父类别和子类别的物料,更全面但可能包含不需要的物料 +' - False: 仅返回指定类别的物料,更精确但可能遗漏子类别的替代物料 ' ' 【相关方法】 ' - GetMaterialsByCategoryAndModel: 结合了类别层级逻辑的物料获取 @@ -402,7 +414,8 @@ End Sub ' - ParseModelAndExtractConditions: 仅解析型号并返回条件字典 ' ======================================== Public Function GetMaterialsByModel(modelStr As String, _ - Optional categoryName As String = "") As collection + Optional categoryName As String = "", _ + Optional autoFallback As Boolean = True) As collection Dim result As collection Set result = New collection @@ -430,7 +443,7 @@ Public Function GetMaterialsByModel(modelStr As String, _ Debug.Print "" ' ======================================== - ' 第2步: 按类别筛选物料（自动降级到子类别） + ' 第2步: 按类别筛选物料（根据参数决定是否自动降级到子类别） ' ======================================== Dim matcher As New clsConditionMatcher Dim totalMatchCount As Long @@ -440,6 +453,13 @@ Public Function GetMaterialsByModel(modelStr As String, _ Dim i As Long, j As Long totalMatchCount = 0 + If autoFallback Then + Debug.Print "【降级模式】启用自动降级到子类别" + Else + Debug.Print "【降级模式】禁用自动降级，仅查找当前类别" + End If + Debug.Print "" + If categoryName <> "" Then ' ======================================== ' 情况A: 指定了类别名称 @@ -448,8 +468,8 @@ Public Function GetMaterialsByModel(modelStr As String, _ Set cat = GetCategory(categoryName) If Not cat Is Nothing Then - ' 从该类别开始查找（包含子类别降级逻辑） - Set catResult = FilterCategoryWithSubcategories(cat, matcher, conditions) + ' 从该类别开始查找（根据参数决定是否启用子类别降级逻辑） + Set catResult = FilterCategoryWithSubcategories(cat, matcher, conditions, autoFallback) ' 合并结果 For i = 1 To catResult.Count @@ -465,8 +485,8 @@ Public Function GetMaterialsByModel(modelStr As String, _ For j = 1 To rootCategories.Count Set rootCat = rootCategories(j) - ' 对每个根类别应用筛选（包含子类别降级逻辑） - Set catResult = FilterCategoryWithSubcategories(rootCat, matcher, conditions) + ' 对每个根类别应用筛选（根据参数决定是否启用子类别降级逻辑） + Set catResult = FilterCategoryWithSubcategories(rootCat, matcher, conditions, autoFallback) ' 合并结果 For i = 1 To catResult.Count @@ -484,29 +504,34 @@ End Function ' ======================================== ' FilterCategoryWithSubcategories 方法 (私有) -' 功能: 对指定类别进行筛选，如果无匹配则自动降级到子类别 +' 功能: 对指定类别进行筛选，根据参数决定是否自动降级到子类别 ' 参数: -' cat - 类别对象 -' matcher - 条件匹配器对象 -' conditions - 提取的条件字典 +' cat - 类别对象 +' matcher - 条件匹配器对象 +' conditions - 提取的条件字典 +' autoFallback - 是否自动降级到子类别（默认True） +' True: 当前类别无匹配时，自动降级到子类别查找 +' False: 仅在当前类别查找，不降级到子类别 ' 返回: Collection对象，包含匹配的物料 ' ' 工作逻辑: ' 1. 先尝试在当前类别下筛选物料 ' 2. 如果当前类别有匹配结果，直接返回 -' 3. 如果当前类别无匹配结果，检查是否有子类别 -' 4. 如果有子类别，递归对所有子类别进行筛选 -' 5. 如果无子类别，返回空集合 +' 3. 如果当前类别无匹配结果且 autoFallback=True，检查是否有子类别 +' 4. 如果有子类别且允许降级，递归对所有子类别进行筛选 +' 5. 如果无子类别或不允许降级，返回当前结果 ' ' 示例场景: ' 型号: "YTHN-100.A0.532.M203.M16.Y3" ' 类别"部件"下有物料"低压接头部件"（条件: lcfw=M02） ' 如果该型号的量程不是M02，则"部件"类别无匹配 -' 此时自动降级到子类别"接头"、"弹性元件"等查找 +' 当 autoFallback=True 时，自动降级到子类别"接头"、"弹性元件"等查找 +' 当 autoFallback=False 时，返回空集合，不查找子类别 ' ======================================== Private Function FilterCategoryWithSubcategories(ByVal cat As clsCategory, _ ByVal matcher As clsConditionMatcher, _ - ByVal conditions As Object) As collection + ByVal conditions As Object, _ + ByVal autoFallback As Boolean) As collection Dim result As collection Set result = New collection @@ -539,9 +564,9 @@ Private Function FilterCategoryWithSubcategories(ByVal cat As clsCategory, _ Next i ' ======================================== - ' 第二阶段: 如果当前类别无匹配，检查子类别 + ' 第二阶段: 如果当前类别无匹配且允许降级，检查子类别 ' ======================================== - If matchCount = 0 And cat.HasSubCategories Then + If matchCount = 0 And cat.HasSubCategories And autoFallback Then Debug.Print "【降级】类别 """ & cat.categoryName & """ 无匹配物料，降级到子类别查找..." ' 递归处理所有子类别 @@ -550,9 +575,9 @@ Private Function FilterCategoryWithSubcategories(ByVal cat As clsCategory, _ For j = 1 To cat.SubCategories.Count Set subCat = cat.SubCategories(j) - ' 递归调用，获取子类别的匹配结果 + ' 递归调用，获取子类别的匹配结果（传递相同的 autoFallback 参数） Dim subResult As collection - Set subResult = FilterCategoryWithSubcategories(subCat, matcher, conditions) + Set subResult = FilterCategoryWithSubcategories(subCat, matcher, conditions, autoFallback) ' 合并子类别的结果 Dim k As Long @@ -560,6 +585,8 @@ Private Function FilterCategoryWithSubcategories(ByVal cat As clsCategory, _ result.Add subResult(k) Next k Next j + ElseIf matchCount = 0 And cat.HasSubCategories And Not autoFallback Then + Debug.Print "【跳过】类别 """ & cat.categoryName & """ 无匹配物料，但降级已禁用，不查找子类别" ElseIf matchCount > 0 Then Debug.Print "【成功】类别 """ & cat.categoryName & """ 匹配 " & matchCount & " 个物料" End If diff --git a/VBA/Modules/modModelParserExamples.bas b/VBA/Modules/modModelParserExamples.bas index 1aed096..47d4a42 100644 --- a/VBA/Modules/modModelParserExamples.bas +++ b/VBA/Modules/modModelParserExamples.bas @@ -374,4 +374,129 @@ Sub Example5_ValidateMaterialConditions() wsValidation.Columns("A:D").AutoFit MsgBox "条件验证完成！", vbInformation +End Sub + +' ======================================== +' 示例6: 对比启用/禁用自动降级的效果 +' ======================================== +Sub Example6_CompareAutoFallback() + 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 modelStr As String + modelStr = "YTHN-100.A0.532.M203.M17.Y3|BP-095.2312.M16.PA3" + + ' 创建对比结果表 + Dim wsCompare As Worksheet + On Error Resume Next + Application.DisplayAlerts = False + ThisWorkbook.Worksheets("降级模式对比").Delete + Application.DisplayAlerts = True + On Error GoTo 0 + + Set wsCompare = ThisWorkbook.Worksheets.Add + wsCompare.Name = "降级模式对比" + + ' 表头 + Dim row As Long + row = 1 + wsCompare.Cells(row, 1).value = "型号" + wsCompare.Cells(row, 2).value = modelStr + row = row + 2 + + ' 测试1: 启用自动降级 + wsCompare.Cells(row, 1).value = "模式1: 启用自动降级 (autoFallback=True)" + wsCompare.Cells(row, 1).Font.Bold = True + row = row + 1 + + wsCompare.Cells(row, 1).value = "类别" + wsCompare.Cells(row, 2).value = "代号" + wsCompare.Cells(row, 3).value = "名称" + wsCompare.Cells(row, 4).value = "数量" + wsCompare.Cells(row, 5).value = "选择条件" + wsCompare.Range("A" & row & ":E" & row).Font.Bold = True + row = row + 1 + + Dim materials As collection + Dim mat As clsMaterialItem + Dim i As Long + + ' 获取启用自动降级的物料 + Set materials = bomMgr.GetMaterialsByModel(modelStr, "部件", True) + + If materials.Count = 0 Then + wsCompare.Cells(row, 1).value = "(无物料)" + row = row + 1 + Else + For i = 1 To materials.Count + Set mat = materials(i) + wsCompare.Cells(row, 1).value = mat.Category + wsCompare.Cells(row, 2).value = mat.code + wsCompare.Cells(row, 3).value = mat.Name + wsCompare.Cells(row, 4).value = mat.Quantity + wsCompare.Cells(row, 5).value = IIf(mat.Condition = "", "(无)", mat.Condition) + row = row + 1 + Next i + End If + + row = row + 1 + + ' 测试2: 禁用自动降级 + wsCompare.Cells(row, 1).value = "模式2: 禁用自动降级 (autoFallback=False)" + wsCompare.Cells(row, 1).Font.Bold = True + row = row + 1 + + wsCompare.Cells(row, 1).value = "类别" + wsCompare.Cells(row, 2).value = "代号" + wsCompare.Cells(row, 3).value = "名称" + wsCompare.Cells(row, 4).value = "数量" + wsCompare.Cells(row, 5).value = "选择条件" + wsCompare.Range("A" & row & ":E" & row).Font.Bold = True + row = row + 1 + + ' 获取禁用自动降级的物料 + Set materials = bomMgr.GetMaterialsByModel(modelStr, "部件", False) + + If materials.Count = 0 Then + wsCompare.Cells(row, 1).value = "(无物料 - 因为禁用降级)" + wsCompare.Cells(row, 2).value = "说明" + wsCompare.Cells(row, 3).value = "当父类别无匹配物料时,不会降级到子类别查找" + row = row + 1 + Else + For i = 1 To materials.Count + Set mat = materials(i) + wsCompare.Cells(row, 1).value = mat.Category + wsCompare.Cells(row, 2).value = mat.code + wsCompare.Cells(row, 3).value = mat.Name + wsCompare.Cells(row, 4).value = mat.Quantity + wsCompare.Cells(row, 5).value = IIf(mat.Condition = "", "(无)", mat.Condition) + row = row + 1 + Next i + End If + + ' 添加说明 + row = row + 1 + wsCompare.Cells(row, 1).value = "说明:" + wsCompare.Cells(row, 1).Font.Bold = True + row = row + 1 + wsCompare.Cells(row, 1).value = "• autoFallback=True (默认): 当""部件""类别无匹配物料时,自动降级到子类别""接头""、""弹性元件""等查找" + row = row + 1 + wsCompare.Cells(row, 1).value = "• autoFallback=False: 仅在""部件""类别查找,即使有子类别也不降级,可能返回空集合" + + ' 格式化 + wsCompare.Columns("A:E").AutoFit + wsCompare.Range("A1").Font.Bold = True + + MsgBox "降级模式对比完成！" & vbCrLf & _ + "请查看工作表: 降级模式对比" & vbCrLf & vbCrLf & _ + "启用降级: " & bomMgr.GetMaterialsByModel(modelStr, "部件", True).Count & " 个物料" & vbCrLf & _ + "禁用降级: " & bomMgr.GetMaterialsByModel(modelStr, "部件", False).Count & " 个物料", _ + vbInformation End Sub \ No newline at end of file