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.
This commit is contained in:
@@ -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
|
||||
|
||||
' ========================================
|
||||
|
||||
Reference in New Issue
Block a user