c9cf84ed4d
Changes:
1. Update all modules to use LoadData(wsPlatform) instead of LoadData(wsConfig, wsPlatform)
- modModelParserExamples.bas: Update 7 example procedures
- modBOMProcessor.bas: Update 4 procedures
- modModelParserTest.bas: Update 2 test procedures
2. Fix completeness check logic in GetValidMaterialsByModel
- Only check root categories to avoid duplicate checking of subcategories
- Previously, all required categories (including subcategories) were checked,
causing subcategories to be added to missing list multiple times
- Now only checks categories with ParentCategoryName = ""
- CheckCategoryCompleteness already recursively checks all subcategories
3. Improve completeness judgment logic for categories with subcategories
- Method 1: Parent category has 1 matching material → Complete
- Method 2: Parent category has 0 matching materials, but all subcategories are complete → Complete
- Other cases → Incomplete
Impact:
- Fixes "category missing" errors in Example9_BatchProcessOrders_WithCheck
- Eliminates duplicate entries in missing categories list
- Properly handles category hierarchy where parent categories are satisfied through subcategories
Co-Authored-By: Claude Sonnet 4.5 <noreply@anthropic.com>
987 lines
39 KiB
OpenEdge ABL
987 lines
39 KiB
OpenEdge ABL
' ========================================
|
||
' 类模块: clsBOMManager
|
||
' 用途: 管理整个BOM数据结构
|
||
' 功能:
|
||
' 1. 加载和组织BOM数据
|
||
' 2. 建立类别层级关系
|
||
' 3. 提供物料查询接口
|
||
' 4. 支持领料逻辑处理
|
||
' ========================================
|
||
Option Explicit
|
||
|
||
' ========================================
|
||
' 私有成员变量
|
||
' ========================================
|
||
Private dictCategories As Object ' Dictionary对象: 类别名称 -> clsCategory对象
|
||
' 作用: 快速查找任意类别
|
||
Private dictAllMaterials As Object ' Dictionary对象: 物料代号 -> clsMaterialItem对象
|
||
' 作用: 快速查找任意物料
|
||
Private rootCategories As collection ' Collection: 存储所有顶层类别(无父类别的类别)
|
||
' 作用: 遍历完整的类别树结构
|
||
|
||
' ========================================
|
||
' 类初始化
|
||
' 说明: 创建BOMManager实例时自动调用
|
||
' ========================================
|
||
Private Sub Class_Initialize()
|
||
Set dictCategories = CreateObject("Scripting.Dictionary")
|
||
Set dictAllMaterials = CreateObject("Scripting.Dictionary")
|
||
Set rootCategories = New collection
|
||
End Sub
|
||
|
||
' ========================================
|
||
' LoadData 方法
|
||
' 功能: 从[平台配置清单]工作表加载BOM数据并构建数据结构
|
||
' 参数:
|
||
' wsPlatform - [平台配置清单]工作表对象,包含完整的物料信息和类别配置
|
||
' 表结构: 行号|模块|代号|名称|数量|选择条件|备注|类别|上层类别|类别选用条件|66代码
|
||
' 数据从第4行开始(前3行是标题)
|
||
' 处理步骤:
|
||
' 1. 从[平台配置清单]一次性加载所有物料信息和类别信息
|
||
' 2. 建立类别的父子关系,构建层级树
|
||
'
|
||
' 重要说明:
|
||
' - 所有数据都从[平台配置清单]读取,不再需要[领料配置]表
|
||
' - 只有"类别"字段不为空的物料才会被添加到类别中
|
||
' - "类别选用条件"用于判断该类别是否需要(为空表示总是需要)
|
||
' - "66代码"是66系统使用的代码
|
||
' ========================================
|
||
Public Sub LoadData(wsPlatform As Worksheet)
|
||
Dim i As Long, lastRow As Long
|
||
Dim mat As clsMaterialItem
|
||
Dim cat As clsCategory
|
||
|
||
' ========================================
|
||
' 第一步: 从平台配置清单加载所有物料和类别信息
|
||
' 说明:
|
||
' 读取列说明:
|
||
' - C列(代号)、D列(名称)、E列(数量)、F列(选择条件)
|
||
' - H列(类别)、I列(上层类别)、J列(类别选用条件)、K列(66代码)
|
||
' - 从第4行开始读取(前3行是标题)
|
||
'
|
||
' 处理逻辑:
|
||
' 1. 所有物料都存入dictAllMaterials字典(包括无类别的物料)
|
||
' 2. 只有"类别"字段不为空的物料才创建类别并添加到类别中
|
||
' 3. 类别对象保存CategorySelectCondition属性
|
||
' 4. 物料对象保存CategorySelectCondition和Code66属性
|
||
' ========================================
|
||
lastRow = wsPlatform.Cells(wsPlatform.Rows.Count, "C").End(xlUp).row
|
||
|
||
For i = 4 To lastRow ' 从第4行开始(跳过标题)
|
||
' 1. 创建物料对象并读取基础信息
|
||
Set mat = New clsMaterialItem
|
||
mat.code = Trim(wsPlatform.Cells(i, "C").value & "") ' 物料代号
|
||
mat.Name = Trim(wsPlatform.Cells(i, "D").value & "") ' 物料名称
|
||
On Error Resume Next
|
||
mat.Quantity = CDbl(wsPlatform.Cells(i, "E").value) ' 物料数量
|
||
On Error GoTo 0
|
||
mat.Condition = Trim(wsPlatform.Cells(i, "F").value & "") ' 选择条件
|
||
|
||
' 2. 读取类别相关字段
|
||
Dim catName As String
|
||
Dim parentCatName As String
|
||
Dim catSelectCond As String
|
||
Dim code66 As String
|
||
|
||
catName = Trim(wsPlatform.Cells(i, "H").value & "") ' 类别
|
||
parentCatName = Trim(wsPlatform.Cells(i, "I").value & "") ' 上层类别
|
||
catSelectCond = Trim(wsPlatform.Cells(i, "J").value & "") ' 类别选用条件
|
||
code66 = Trim(wsPlatform.Cells(i, "K").value & "") ' 66代码
|
||
|
||
' 3. 保存类别相关属性到物料对象
|
||
mat.Category = catName
|
||
mat.ParentCategory = parentCatName
|
||
mat.CategorySelectCondition = catSelectCond
|
||
mat.Code66 = code66
|
||
|
||
' 4. 将物料保存到字典(所有物料都保存,包括无类别的)
|
||
If mat.code <> "" Then
|
||
Set dictAllMaterials(mat.code) = mat
|
||
End If
|
||
|
||
' 5. 如果物料有类别,创建或更新类别对象,并将物料添加到类别
|
||
If catName <> "" Then
|
||
' 确保类别对象存在(如果类别不存在则创建)
|
||
If Not dictCategories.Exists(catName) Then
|
||
Set cat = New clsCategory
|
||
cat.categoryName = catName
|
||
cat.ParentCategoryName = parentCatName
|
||
cat.CategorySelectCondition = catSelectCond ' ⭐ 设置类别选用条件
|
||
Set dictCategories(catName) = cat
|
||
End If
|
||
|
||
' 将物料添加到类别
|
||
dictCategories(catName).AddMaterial mat
|
||
End If
|
||
Next i
|
||
|
||
' ========================================
|
||
' 第二步: 建立类别层级关系
|
||
' 说明:
|
||
' - 遍历所有类别,根据ParentCategoryName建立父子关系
|
||
' - 如果类别有父类别,将自己添加到父类别的SubCategories中
|
||
' - 如果类别没有父类别,则为根类别,添加到rootCategories中
|
||
' 结果:
|
||
' - 构建完整的树形结构
|
||
' - rootCategories包含所有顶层类别
|
||
' - 每个类别的SubCategories包含其直接子类别
|
||
' ========================================
|
||
Dim key As Variant
|
||
For Each key In dictCategories.Keys
|
||
Set cat = dictCategories(key)
|
||
If cat.ParentCategoryName <> "" Then
|
||
' 有父类别,建立父子关系
|
||
If dictCategories.Exists(cat.ParentCategoryName) Then
|
||
Dim parentCat As clsCategory
|
||
Set parentCat = dictCategories(cat.ParentCategoryName)
|
||
parentCat.AddSubCategory cat ' 将当前类别添加为父类别的子类别
|
||
End If
|
||
Else
|
||
' 无父类别,是根类别
|
||
rootCategories.Add cat, cat.categoryName
|
||
End If
|
||
Next key
|
||
End Sub
|
||
|
||
' ========================================
|
||
' GetRootCategories 方法
|
||
' 功能: 获取所有顶层类别的集合
|
||
' 返回: Collection对象,包含所有无父类别的clsCategory对象
|
||
' 用途:
|
||
' - 遍历整个BOM结构时的入口点
|
||
' - 生成领料清单时遍历所有根类别
|
||
' 示例:
|
||
' Dim cats As Collection
|
||
' Set cats = bomMgr.GetRootCategories()
|
||
' For i = 1 To cats.Count
|
||
' Debug.Print cats(i).CategoryName
|
||
' Next i
|
||
' ========================================
|
||
Public Function GetRootCategories() As collection
|
||
Set GetRootCategories = rootCategories
|
||
End Function
|
||
|
||
' ========================================
|
||
' GetCategory 方法
|
||
' 功能: 根据类别名称获取类别对象
|
||
' 参数:
|
||
' categoryName - 要查询的类别名称(字符串)
|
||
' 返回:
|
||
' clsCategory对象 - 如果找到
|
||
' Nothing - 如果未找到
|
||
' 用途: 快速查找特定类别及其下的物料
|
||
' 示例:
|
||
' Dim cat As clsCategory
|
||
' Set cat = bomMgr.GetCategory("部件")
|
||
' If Not cat Is Nothing Then
|
||
' Debug.Print cat.Materials.Count & " 个物料"
|
||
' End If
|
||
' ========================================
|
||
Public Function GetCategory(categoryName As String) As clsCategory
|
||
If dictCategories.Exists(categoryName) Then
|
||
Set GetCategory = dictCategories(categoryName)
|
||
Else
|
||
Set GetCategory = Nothing
|
||
End If
|
||
End Function
|
||
|
||
' ========================================
|
||
' GetMaterialsForPicking 方法
|
||
' 功能: 获取某类别下需要领料的物料清单(考虑层级逻辑)
|
||
' 参数:
|
||
' categoryName - 类别名称
|
||
' useParent - 可选参数,默认True
|
||
' True: 使用父类别物料(默认领料方式)
|
||
' False: 使用子类别物料(库存不足时的替代方案)
|
||
' 返回: Collection对象,包含clsMaterialItem对象
|
||
'
|
||
' 业务逻辑说明:
|
||
' 1. 默认领取父类别的物料(如"低压接头部件")
|
||
' 2. 当父类别库存不足时,才领取子类别的物料(如"接头"+"弹性元件")
|
||
' 3. 如果useParent=True但类别有子类别,仍返回父类别物料
|
||
' 4. 如果useParent=False,递归获取所有子类别的物料
|
||
'
|
||
' 示例1: 获取"部件"类别的物料(父类别)
|
||
' Set mats = bomMgr.GetMaterialsForPicking("部件", True)
|
||
' ' 返回: 低压接头部件、高压接头部件等组装好的部件
|
||
'
|
||
' 示例2: 获取"部件"类别的物料(子类别展开)
|
||
' Set mats = bomMgr.GetMaterialsForPicking("部件", False)
|
||
' ' 返回: 径向低压接头、弹簧管、螺旋管等零件
|
||
' ========================================
|
||
Public Function GetMaterialsForPicking(categoryName As String, _
|
||
Optional useParent As Boolean = True) As collection
|
||
Dim result As collection
|
||
Set result = New collection
|
||
|
||
' 查找指定类别
|
||
Dim cat As clsCategory
|
||
Set cat = GetCategory(categoryName)
|
||
If cat Is Nothing Then
|
||
' 类别不存在,返回空集合
|
||
Set GetMaterialsForPicking = result
|
||
Exit Function
|
||
End If
|
||
|
||
Dim i As Long
|
||
|
||
If useParent Then
|
||
' ========================================
|
||
' 使用父类别物料(默认领料方式)
|
||
' 说明:
|
||
' - 直接返回当前类别下的所有物料
|
||
' - 即使该类别有子类别,也仍然返回父类别物料
|
||
' - 这是正常情况下的领料方式(领取组装好的部件)
|
||
' ========================================
|
||
Dim m As clsMaterialItem
|
||
For i = 1 To cat.materials.Count
|
||
Set m = cat.materials(i)
|
||
result.Add m
|
||
Next i
|
||
Else
|
||
' ========================================
|
||
' 使用子类别物料(库存不足时的替代方案)
|
||
' 说明:
|
||
' - 如果当前类别有子类别,递归获取所有子类别的物料
|
||
' - 如果当前类别是叶子类别(无子类别),返回本类别物料
|
||
' - 这用于父类别库存不足,需要领取零件自行组装的情况
|
||
' 示例:
|
||
' 当"低压接头部件"库存不足时
|
||
' 改为领取"径向低压接头"+"弹簧管"零件
|
||
' ========================================
|
||
If cat.HasSubCategories Then
|
||
' 有子类别,递归获取所有子类别的物料
|
||
Dim subCat As clsCategory
|
||
Dim j As Long
|
||
For j = 1 To cat.SubCategories.Count
|
||
Set subCat = cat.SubCategories(j)
|
||
Dim subMats As collection
|
||
' 递归调用,继续展开子类别
|
||
Set subMats = GetMaterialsForPicking(subCat.categoryName, False)
|
||
Dim k As Long
|
||
For k = 1 To subMats.Count
|
||
result.Add subMats(k)
|
||
Next k
|
||
Next j
|
||
Else
|
||
' 叶子类别,返回本类别物料
|
||
For i = 1 To cat.materials.Count
|
||
Set m = cat.materials(i)
|
||
result.Add m
|
||
Next i
|
||
End If
|
||
End If
|
||
|
||
Set GetMaterialsForPicking = result
|
||
End Function
|
||
|
||
' ========================================
|
||
' PrintCategoryTree 方法
|
||
' 功能: 将类别树结构打印到工作表(用于调试和查看)
|
||
' 参数:
|
||
' ws - 输出的目标工作表对象
|
||
' 输出格式:
|
||
' - 第一列: 类别名称(带缩进显示层级)
|
||
' - 第二列: 物料数量信息
|
||
' - 第三列: 选择条件
|
||
' 说明:
|
||
' - 使用缩进显示类别层级(每层2个空格)
|
||
' - 递归打印所有子类别和物料
|
||
' - 便于验证数据结构是否正确
|
||
' 示例输出:
|
||
' 表壳 (物料数:1)
|
||
' - 01091004312 表壳(本色) 数量:1 条件:
|
||
' 部件 (物料数:20)
|
||
' - 01011019001 低压接头部件 数量:1 条件:lcfw=M02...
|
||
' 接头 (物料数:18)
|
||
' - 01081013833 径向低压接头 数量:1 条件:gclj=Z12...
|
||
' ========================================
|
||
Public Sub PrintCategoryTree(ws As Worksheet)
|
||
Dim row As Long
|
||
row = 1
|
||
ws.Cells(row, 1).value = "类别层级结构"
|
||
row = row + 1
|
||
|
||
' 遍历所有根类别,递归打印整个树
|
||
Dim rootCat As clsCategory
|
||
Dim i As Long
|
||
For i = 1 To rootCategories.Count
|
||
Set rootCat = rootCategories(i)
|
||
Call PrintCategory(ws, rootCat, row, 0)
|
||
Next i
|
||
End Sub
|
||
|
||
' ========================================
|
||
' PrintCategory 方法 (私有方法)
|
||
' 功能: 递归打印单个类别及其子类别(供PrintCategoryTree调用)
|
||
' 参数:
|
||
' ws - 输出的工作表对象
|
||
' cat - 要打印的类别对象
|
||
' row - 当前输出行号(ByRef,会被修改)
|
||
' level - 当前层级深度(0=根类别,1=一级子类别...)
|
||
' 说明:
|
||
' - 使用递归方式遍历整个类别树
|
||
' - 根据level参数计算缩进空格数
|
||
' - 先打印类别名,再打印该类别的所有物料,最后递归打印子类别
|
||
' ========================================
|
||
Private Sub PrintCategory(ws As Worksheet, cat As clsCategory, _
|
||
ByRef row As Long, level As Integer)
|
||
' 计算缩进(每层2个空格)
|
||
Dim indent As String
|
||
indent = String(level * 2, " ")
|
||
|
||
' 打印类别名称和物料数量统计
|
||
ws.Cells(row, 1).value = indent & cat.categoryName & _
|
||
" (物料数:" & cat.materials.Count & ")"
|
||
row = row + 1
|
||
|
||
' 打印该类别下的所有物料
|
||
Dim mat As clsMaterialItem
|
||
Dim i As Long
|
||
For i = 1 To cat.materials.Count
|
||
Set mat = cat.materials(i)
|
||
' 物料行额外缩进2个空格,并加上"- "前缀
|
||
ws.Cells(row, 1).value = indent & " - " & mat.code & " " & mat.Name
|
||
ws.Cells(row, 2).value = "数量:" & mat.Quantity
|
||
ws.Cells(row, 3).value = "条件:" & mat.Condition
|
||
row = row + 1
|
||
Next i
|
||
|
||
' 递归打印所有子类别
|
||
Dim subCat As clsCategory
|
||
Dim j As Long
|
||
For j = 1 To cat.SubCategories.Count
|
||
Set subCat = cat.SubCategories(j)
|
||
' 递归调用,层级加1
|
||
Call PrintCategory(ws, subCat, row, level + 1)
|
||
Next j
|
||
End Sub
|
||
' ========================================
|
||
' GetMaterialsByModel 方法
|
||
'
|
||
' 【功能概述】
|
||
' 根据产品型号字符串自动解析规格参数,并返回符合这些规格的所有物料清单。
|
||
' 这是BOM系统的核心方法,实现了从"产品型号"到"物料清单"的智能转换。
|
||
'
|
||
' 【工作流程】
|
||
' 1. 型号解析 (clsModelParser) → 将产品型号字符串拆解为结构化参数
|
||
' 2. 条件提取 (clsConditionExtractor) → 从型号参数中提取匹配条件变量
|
||
' 3. 物料筛选 (clsConditionMatcher) → 根据条件从物料库中筛选符合条件的物料
|
||
'
|
||
' 【参数说明】
|
||
' modelStr - 产品型号字符串
|
||
' 格式: [型号]-[口径].[安装].[表壳].[连接].[量程]|[表盘]|[附件]|[法兰]
|
||
' 示例: "YTHN-100.A0.532.M203.M16.Y3|BP-095.2312.M16.PA3"
|
||
' 说明: 必须是完整的型号字符串,不能为空
|
||
'
|
||
' categoryName - 类别名称(可选参数,默认为空字符串)
|
||
' 为空字符串 "": 返回所有类别的符合条件物料(默认行为)
|
||
' 指定类别名: 仅返回该类别下的符合条件物料
|
||
' 示例: "部件"、"表壳"、"接头"、"机芯"
|
||
'
|
||
' autoFallback - 是否自动降级到子类别(可选参数,默认为True)
|
||
' True (默认): 当某个类别无匹配物料时,自动降级到其子类别继续查找
|
||
' False: 仅在当前类别查找,不降级到子类别
|
||
' 示例场景:
|
||
' 型号 "YTHN-100.A0.532.M203.M17.Y3" 的量程是M17
|
||
' 类别"部件"下的物料条件是 "lcfw=M02"
|
||
' autoFallback=True: 自动降级到子类别"接头"、"弹性元件"等查找
|
||
' autoFallback=False: "部件"类别返回空集合
|
||
'
|
||
' 【返回值】
|
||
' 返回类型: Collection对象
|
||
' 元素类型: Collection中的每个元素都是 clsMaterialItem 对象
|
||
'
|
||
' clsMaterialItem 对象属性:
|
||
' .code - String - 物料代号(如: "01011019001")
|
||
' .Name - String - 物料名称(如: "低压接头部件")
|
||
' .Quantity - Double - 物料数量(如: 1, 2, 0.5)
|
||
' .Condition - String - 选择条件(如: "lcfw=M02 AND gclj=Z12")
|
||
' .Category - String - 所属类别名称
|
||
' .ParentCategory - String - 上层类别名称
|
||
'
|
||
' 【注意事项】
|
||
' 1. 调用前必须先执行 LoadData() 方法加载BOM数据
|
||
' 2. 型号字符串必须完整且符合格式要求
|
||
' 3. 返回的Collection可能为空(没有符合条件的物料),需要判断Count属性
|
||
' 4. 调试信息会输出到VBA的"立即窗口"(Ctrl+G查看)
|
||
' 5. 物料的Condition属性为空表示该物料无条件限制(所有型号都使用)
|
||
' 6. autoFallback 参数影响查找范围:
|
||
' - True (默认): 会返回父类别和子类别的物料,更全面但可能包含不需要的物料
|
||
' - False: 仅返回指定类别的物料,更精确但可能遗漏子类别的替代物料
|
||
'
|
||
' 【相关方法】
|
||
' - GetMaterialsByCategoryAndModel: 结合了类别层级逻辑的物料获取
|
||
' - GetMaterialsForPicking: 纯粹按类别获取物料(不进行型号匹配)
|
||
' - ParseModelAndExtractConditions: 仅解析型号并返回条件字典
|
||
' ========================================
|
||
Public Function GetMaterialsByModel(modelStr As String, _
|
||
Optional categoryName As String = "", _
|
||
Optional autoFallback As Boolean = True) As collection
|
||
Dim result As collection
|
||
Set result = New collection
|
||
|
||
' ========================================
|
||
' 第1步: 解析型号并提取条件
|
||
' ========================================
|
||
Dim parser As New clsModelParser
|
||
If Not parser.ParseModel(modelStr) Then
|
||
'Debug.Print "型号解析失败: " & parser.ErrorMessage
|
||
Set GetMaterialsByModel = result
|
||
Exit Function
|
||
End If
|
||
|
||
Dim extractor As New clsConditionExtractor
|
||
Dim conditions As Object
|
||
Set conditions = extractor.ExtractConditions(parser)
|
||
|
||
' 调试输出
|
||
'Debug.Print "【型号】: " & modelStr
|
||
'Debug.Print "【提取的条件】:"
|
||
Dim key As Variant
|
||
For Each key In conditions.Keys
|
||
'Debug.Print " " & key & " = " & conditions(key)
|
||
Next key
|
||
'Debug.Print ""
|
||
|
||
' ========================================
|
||
' 第2步: 按类别筛选物料（根据参数决定是否自动降级到子类别）
|
||
' ========================================
|
||
Dim matcher As New clsConditionMatcher
|
||
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 autoFallback Then
|
||
'Debug.Print "【降级模式】启用自动降级到子类别"
|
||
Else
|
||
'Debug.Print "【降级模式】禁用自动降级，仅查找当前类别"
|
||
End If
|
||
'Debug.Print ""
|
||
|
||
If categoryName <> "" Then
|
||
' ========================================
|
||
' 情况A: 指定了类别名称
|
||
' 只在该类别及其子类别中查找
|
||
' ========================================
|
||
Set cat = GetCategory(categoryName)
|
||
|
||
If Not cat Is Nothing Then
|
||
' 从该类别开始查找（根据参数决定是否启用子类别降级逻辑）
|
||
Set catResult = FilterCategoryWithSubcategories(cat, matcher, conditions, autoFallback)
|
||
|
||
' 合并结果
|
||
For i = 1 To catResult.Count
|
||
result.Add catResult(i)
|
||
Next i
|
||
totalMatchCount = catResult.Count
|
||
End If
|
||
Else
|
||
' ========================================
|
||
' 情况B: 未指定类别名称
|
||
' 遍历所有根类别，对每个类别应用子类别降级逻辑
|
||
' ========================================
|
||
For j = 1 To rootCategories.Count
|
||
Set rootCat = rootCategories(j)
|
||
|
||
' 对每个根类别应用筛选（根据参数决定是否启用子类别降级逻辑）
|
||
Set catResult = FilterCategoryWithSubcategories(rootCat, matcher, conditions, autoFallback)
|
||
|
||
' 合并结果
|
||
For i = 1 To catResult.Count
|
||
result.Add catResult(i)
|
||
Next i
|
||
totalMatchCount = totalMatchCount + catResult.Count
|
||
Next j
|
||
End If
|
||
|
||
'Debug.Print "共匹配 " & totalMatchCount & " 个物料"
|
||
'Debug.Print String(60, "=")
|
||
|
||
Set GetMaterialsByModel = result
|
||
End Function
|
||
|
||
' ========================================
|
||
' FilterCategoryWithSubcategories 方法 (私有)
|
||
' 功能: 对指定类别进行筛选，根据参数决定是否自动降级到子类别
|
||
' 参数:
|
||
' cat - 类别对象
|
||
' matcher - 条件匹配器对象
|
||
' conditions - 提取的条件字典
|
||
' autoFallback - 是否自动降级到子类别（默认True）
|
||
' True: 当前类别无匹配时，自动降级到子类别查找
|
||
' False: 仅在当前类别查找，不降级到子类别
|
||
' 返回: Collection对象，包含匹配的物料
|
||
'
|
||
' 工作逻辑:
|
||
' 1. 先尝试在当前类别下筛选物料
|
||
' 2. 如果当前类别有匹配结果，直接返回
|
||
' 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, _
|
||
ByVal autoFallback As Boolean) 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 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 "【匹配】" & cat.categoryName & " > " & _
|
||
mat.code & " - " & mat.Name & _
|
||
" | 条件: " & IIf(mat.Condition = "", "(无)", mat.Condition)
|
||
End If
|
||
Next i
|
||
|
||
' ========================================
|
||
' 第二阶段: 如果当前类别无匹配且允许降级，检查子类别
|
||
' ========================================
|
||
If matchCount = 0 And cat.HasSubCategories And autoFallback Then
|
||
'Debug.Print "【降级】类别 """ & cat.categoryName & """ 无匹配物料，降级到子类别查找..."
|
||
|
||
' 递归处理所有子类别
|
||
Dim subCat As clsCategory
|
||
Dim j As Long
|
||
For j = 1 To cat.SubCategories.Count
|
||
Set subCat = cat.SubCategories(j)
|
||
|
||
' 递归调用，获取子类别的匹配结果（传递相同的 autoFallback 参数）
|
||
Dim subResult As collection
|
||
Set subResult = FilterCategoryWithSubcategories(subCat, matcher, conditions, autoFallback)
|
||
|
||
' 合并子类别的结果
|
||
Dim k As Long
|
||
For k = 1 To subResult.Count
|
||
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
|
||
|
||
Set FilterCategoryWithSubcategories = result
|
||
End Function
|
||
|
||
' ========================================
|
||
' CollectAllMaterials 方法 (私有)
|
||
' 功能: 递归收集类别及其所有子类别的物料
|
||
' 参数:
|
||
' cat - 类别对象
|
||
' collection - 用于存储物料的Collection
|
||
' ========================================
|
||
Private Sub CollectAllMaterials(cat As clsCategory, collection As collection)
|
||
Dim i As Long
|
||
|
||
' 添加当前类别的所有物料
|
||
For i = 1 To cat.materials.Count
|
||
collection.Add cat.materials(i)
|
||
Next i
|
||
|
||
' 递归处理子类别
|
||
Dim subCat As clsCategory
|
||
Dim j As Long
|
||
For j = 1 To cat.SubCategories.Count
|
||
Set subCat = cat.SubCategories(j)
|
||
Call CollectAllMaterials(subCat, collection)
|
||
Next j
|
||
End Sub
|
||
|
||
' ========================================
|
||
' GetMaterialsByCategoryAndModel 方法
|
||
' 功能: 根据类别和型号获取物料（使用父类别或子类别逻辑）
|
||
' 参数:
|
||
' modelStr - 产品型号字符串
|
||
' categoryName - 类别名称
|
||
' useParent - True=使用父类别物料，False=使用子类别物料
|
||
' 返回: Collection对象，包含符合条件的clsMaterialItem对象
|
||
' 说明: 这是 GetMaterialsForPicking 和 GetMaterialsByModel 的结合
|
||
' ========================================
|
||
Public Function GetMaterialsByCategoryAndModel(modelStr As String, _
|
||
categoryName As String, _
|
||
Optional useParent As Boolean = True) As collection
|
||
Dim result As collection
|
||
Set result = New collection
|
||
|
||
' 1. 解析型号并提取条件
|
||
Dim parser As New clsModelParser
|
||
If Not parser.ParseModel(modelStr) Then
|
||
Set GetMaterialsByCategoryAndModel = result
|
||
Exit Function
|
||
End If
|
||
|
||
Dim extractor As New clsConditionExtractor
|
||
Dim conditions As Object
|
||
Set conditions = extractor.ExtractConditions(parser)
|
||
|
||
' 2. 获取类别的物料（根据 useParent 参数）
|
||
Dim materialsToFilter As collection
|
||
Set materialsToFilter = GetMaterialsForPicking(categoryName, useParent)
|
||
|
||
' 3. 筛选符合条件的物料
|
||
Dim matcher As New clsConditionMatcher
|
||
Dim mat As clsMaterialItem
|
||
|
||
For Each mat In materialsToFilter
|
||
If matcher.IsMatch(mat.Condition, conditions) Then
|
||
result.Add mat
|
||
End If
|
||
Next mat
|
||
|
||
Set GetMaterialsByCategoryAndModel = result
|
||
End Function
|
||
|
||
' ========================================
|
||
' GetRequiredCategories 方法 (私有)
|
||
' 功能: 根据型号条件确定哪些类别是需要的
|
||
' 参数:
|
||
' conditions - 从型号提取的条件字典 (Dictionary对象)
|
||
' 包含如 lcfw, gclj, jycz 等条件变量
|
||
' 返回: Collection对象, 包含所有需要的 clsCategory 对象
|
||
'
|
||
' 判断逻辑:
|
||
' 遍历所有类别,对每个类别调用 IsRequiredForModel(conditions) 方法:
|
||
' - 如果类别选用条件为空 → 该类别总是需要,添加到结果集
|
||
' - 如果类别选用条件不为空 → 用 conditions 匹配
|
||
' - 匹配成功 → 添加到结果集
|
||
' - 匹配失败 → 不添加
|
||
'
|
||
' 示例:
|
||
' 假设型号条件为: lcfw=M16, gclj=M20
|
||
'
|
||
' 类别1: CategorySelectCondition = ""
|
||
' → IsRequiredForModel = True → 添加到结果集
|
||
'
|
||
' 类别2: CategorySelectCondition = "lcfw=M02"
|
||
' → IsRequiredForModel = False → 不添加
|
||
'
|
||
' 类别3: CategorySelectCondition = "gclj=M20"
|
||
' → IsRequiredForModel = True → 添加到结果集
|
||
'
|
||
' 用途:
|
||
' 在 GetValidMaterialsByModel 中,只检查需要的类别是否有物料匹配
|
||
' 不需要的类别不参与完整性检查
|
||
' ========================================
|
||
Private Function GetRequiredCategories(conditions As Object) As collection
|
||
Dim result As collection
|
||
Set result = New collection
|
||
|
||
' 遍历所有类别
|
||
Dim key As Variant
|
||
For Each key In dictCategories.Keys
|
||
Dim cat As clsCategory
|
||
Set cat = dictCategories(key)
|
||
|
||
' 检查该类别是否需要
|
||
If cat.IsRequiredForModel(conditions) Then
|
||
result.Add cat
|
||
End If
|
||
Next key
|
||
|
||
Set GetRequiredCategories = result
|
||
End Function
|
||
|
||
' ========================================
|
||
' ParseModelAndExtractConditions 方法
|
||
' 功能: 解析型号并返回条件字典（工具方法）
|
||
' 参数: modelStr - 产品型号字符串
|
||
' 返回: Dictionary对象，包含提取的条件
|
||
' 用途: 供外部调用，用于查看提取的条件
|
||
' ========================================
|
||
Public Function ParseModelAndExtractConditions(modelStr As String) As Object
|
||
Dim parser As New clsModelParser
|
||
Dim extractor As New clsConditionExtractor
|
||
Dim conditions As Object
|
||
|
||
If parser.ParseModel(modelStr) Then
|
||
Set conditions = extractor.ExtractConditions(parser)
|
||
Else
|
||
Set conditions = CreateObject("Scripting.Dictionary")
|
||
End If
|
||
|
||
Set ParseModelAndExtractConditions = conditions
|
||
End Function
|
||
|
||
' ========================================
|
||
' GetValidMaterialsByModel 方法
|
||
' 功能: 根据产品型号获取物料，并判断是否为完整的物料集合
|
||
' 参数:
|
||
' modelStr - 产品型号字符串
|
||
' 返回: Collection对象
|
||
' Collection中包含三个元素:
|
||
' (1) "Materials" - Collection对象,包含所有匹配的 clsMaterialItem 对象
|
||
' (2) "IsComplete" - Boolean值,指示物料是否完整
|
||
' (3) "MissingCategories" - Collection对象, 包含所有缺失的类别名称字符串
|
||
'
|
||
' ⭐ 完整性判断规则(重构后):
|
||
' 第一步: 确定哪些类别是该型号需要的
|
||
' - 遍历所有类别,检查"类别选用条件"
|
||
' - 类别选用条件为空 → 该类别总是需要
|
||
' - 类别选用条件不为空 → 用型号条件匹配,匹配成功才需要
|
||
'
|
||
' 第二步: 只检查需要的类别的完整性
|
||
' - 对于每个需要的类别(顶层类别或其需要领取的子类别)
|
||
' - 必须有且仅有一个物料被匹配
|
||
' - 如果某个需要的类别有0个或多于1个物料,则视为不完整
|
||
' - 不需要的类别不参与完整性检查
|
||
'
|
||
' 示例:
|
||
' 假设型号为 "YTHN-100.A0.532.M203.M16.Y3" (量程M16, 过程连接M20)
|
||
'
|
||
' 类别1: CategorySelectCondition = "" → 总是需要
|
||
' 类别2: CategorySelectCondition = "lcfw=M02" → 不需要(型号量程是M16)
|
||
' 类别3: CategorySelectCondition = "gclj=M20" → 需要(匹配成功)
|
||
'
|
||
' 只有类别1和类别3需要检查完整性,类别2不检查
|
||
'
|
||
' 调用示例:
|
||
' Dim result As Collection
|
||
' Set result = bomMgr.GetValidMaterialsByModel("YTHN-100.A0.532.M203.M16.Y3")
|
||
' Dim materials As Collection
|
||
' Dim isComplete As Boolean
|
||
' Dim missingCats As Collection
|
||
' Set materials = result("Materials")
|
||
' isComplete = result("IsComplete")
|
||
' Set missingCats = result("MissingCategories")
|
||
' ========================================
|
||
Public Function GetValidMaterialsByModel(modelStr As String) As collection
|
||
Dim result As New collection
|
||
Dim allMaterials As New collection
|
||
Dim allMissingCats 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"
|
||
result.Add allMissingCats, "MissingCategories"
|
||
Set GetValidMaterialsByModel = result
|
||
Exit Function
|
||
End If
|
||
|
||
Dim extractor As New clsConditionExtractor
|
||
Dim conditions As Object
|
||
Set conditions = extractor.ExtractConditions(parser)
|
||
|
||
' 条件匹配器
|
||
Dim matcher As New clsConditionMatcher
|
||
|
||
' ⭐ 第一步: 获取需要的类别列表
|
||
Dim requiredCats As collection
|
||
Set requiredCats = GetRequiredCategories(conditions)
|
||
|
||
' ⭐ 第二步: 只检查需要的根类别的完整性
|
||
' 说明: 不检查所有需要的类别，而是只检查根类别
|
||
' 因为 CheckCategoryCompleteness 会递归检查子类别
|
||
' 如果检查所有类别（包括子类别），会导致重复检查和重复添加到 missingCats
|
||
isComplete = True
|
||
|
||
Dim reqCat As clsCategory
|
||
Dim i As Long
|
||
For i = 1 To requiredCats.Count
|
||
Set reqCat = requiredCats(i)
|
||
|
||
' ⭐ 关键修正: 只检查根类别（无父类别的类别）
|
||
' 这样可以避免对"部件"及其子类别"接头"、"弹性元件"都进行检查
|
||
' 否则会导致子类别被重复添加到缺失列表
|
||
If reqCat.ParentCategoryName = "" Then
|
||
' 检查该根类别及其所有子类别的完整性
|
||
Dim catResult As Object
|
||
Set catResult = CheckCategoryCompleteness(reqCat, matcher, conditions)
|
||
|
||
' 1. 合并匹配到的物料
|
||
Dim mat As clsMaterialItem
|
||
Dim matCollection As collection
|
||
Set matCollection = catResult("Materials")
|
||
For Each mat In matCollection
|
||
allMaterials.Add mat
|
||
Next mat
|
||
|
||
' 2. 合并缺失的类别
|
||
Dim missingCollection As collection
|
||
Set missingCollection = catResult("Missing")
|
||
Dim missingCatName As Variant
|
||
For Each missingCatName In missingCollection
|
||
allMissingCats.Add missingCatName
|
||
Next missingCatName
|
||
|
||
' 3. 检查完整性状态
|
||
If Not catResult("IsComplete") Then
|
||
isComplete = False
|
||
End If
|
||
End If ' ⭐ 结束 If reqCat.ParentCategoryName = "" 的判断
|
||
Next i
|
||
|
||
' 返回结果
|
||
result.Add allMaterials, "Materials"
|
||
result.Add isComplete, "IsComplete"
|
||
result.Add allMissingCats, "MissingCategories"
|
||
|
||
Set GetValidMaterialsByModel = result
|
||
End Function
|
||
|
||
' ========================================
|
||
' CheckCategoryCompleteness 方法 (私有)
|
||
' 功能: 检查单个类别的完整性(递归处理子类别)
|
||
' 参数:
|
||
' cat - 类别对象
|
||
' matcher - 条件匹配器
|
||
' conditions - 提取的条件字典
|
||
' 返回: Dictionary对象
|
||
' "Materials" - Collection,包含该类别匹配的物料
|
||
' "IsComplete" - Boolean,该类别是否完整
|
||
' "Missing" - Collection, 缺失的类别名称列表
|
||
'
|
||
' 完整性判断逻辑:
|
||
' 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 missingCats 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: 叶子类别(无子类别)
|
||
' ========================================
|
||
If matchCount = 1 Then
|
||
isComplete = True
|
||
Else
|
||
isComplete = False
|
||
' 如果是叶子节点且没有匹配到物料，记录该类别为缺失
|
||
If matchCount = 0 Then
|
||
missingCats.Add cat.categoryName
|
||
End If
|
||
' 注: matchCount > 1 属于配置错误(重复匹配)，算不完整，但通常不算"Missing"
|
||
End If
|
||
Else
|
||
' ========================================
|
||
' 情况2: 有子类别
|
||
' 完整性判断规则:
|
||
' - 方式一: 父类别有1个匹配物料 → 完整
|
||
' - 方式二: 父类别无匹配物料, 但所有子类别都完整 → 完整
|
||
' - 其他情况 → 不完整
|
||
' ========================================
|
||
If matchCount = 1 Then
|
||
' 方式一: 父类别有且仅有1个物料, 使用父类别 -> 完整
|
||
isComplete = True
|
||
' 不需要检查子类别了，missingCats 保持为空
|
||
ElseIf matchCount = 0 Then
|
||
' 方式二: 父类别无匹配物料, 必须降级检查所有子类别
|
||
|
||
' 清空当前物料集合(确保没东西), 准备收集子类别结果
|
||
Set materials = New collection
|
||
isComplete = True ' 先假设完整, 若任一子类别不完整则置错
|
||
|
||
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)
|
||
|
||
' a) 合并子类别物料
|
||
Dim subMaterials As collection
|
||
Set subMaterials = subResult("Materials")
|
||
Dim k As Long
|
||
For k = 1 To subMaterials.Count
|
||
materials.Add subMaterials(k)
|
||
Next k
|
||
|
||
' b) 合并子类别缺失列表
|
||
Dim subMissing As collection
|
||
Set subMissing = subResult("Missing")
|
||
Dim item As Variant
|
||
For Each item In subMissing
|
||
missingCats.Add item
|
||
Next item
|
||
|
||
' c) 更新完整性状态
|
||
If Not subResult("IsComplete") Then
|
||
isComplete = False
|
||
End If
|
||
Next j
|
||
|
||
' ⭐ 关键修正: 如果所有子类别都完整, 父类别不应该被标记为缺失
|
||
' 只有当父类别是叶子类别且没有物料时, 才应该被标记为缺失
|
||
' 对于有子类别的父类别, 只要所有子类别都完整, 父类别就是完整的
|
||
Else
|
||
' 父类别有 >1 个匹配, 视为不完整(冲突)
|
||
isComplete = False
|
||
' 父类别有多个匹配, 这种情况下不应该标记为缺失(而是配置错误)
|
||
End If
|
||
End If
|
||
|
||
' 封装返回结果
|
||
Set result("Materials") = materials
|
||
result("IsComplete") = isComplete
|
||
Set result("Missing") = missingCats
|
||
Set CheckCategoryCompleteness = result
|
||
End Function |