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:
Misaka_Company
2026-01-20 15:31:43 +08:00
parent 7f89f37f35
commit 388ccc4e7a
2 changed files with 117 additions and 27 deletions

View File

@@ -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
' ========================================