a1347017e3
Refine project overview to include specific business context (Blaidy Company) and the main workbook file. Restructure the architecture section into a layered object-oriented design (Data, Processing, Application layers) and define the responsibilities of core VBA classes. Add new technical documentation sections covering: - Model number format parsing structure - Condition expression language syntax - Category hierarchy logic and picking strategies - Material matching pipeline flow Include VBA code examples for key methods such as CollectAllMaterials and GetMaterialsByCategoryAndModel to illustrate recursive traversal and material retrieval logic. Clarify the structure of key Excel configuration sheets.
533 lines
20 KiB
OpenEdge ABL
533 lines
20 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 方法
|
||
' 功能: 从Excel工作表加载BOM数据并构建数据结构
|
||
' 参数:
|
||
' wsConfig - [领料配置]工作表对象,包含类别层级和需要领料的物料
|
||
' wsPlatform - [平台配置清单]工作表对象,包含完整的物料信息(代号/名称/数量/条件)
|
||
' 处理步骤:
|
||
' 1. 从[平台配置清单]加载所有物料的基础信息到dictAllMaterials
|
||
' 2. 从[领料配置]加载类别信息,筛选需要领料的物料
|
||
' 3. 建立类别的父子关系,构建层级树
|
||
' 注意:
|
||
' - 只有出现在[领料配置]中的物料才会被添加到类别中
|
||
' - 未在[领料配置]中的物料表示不需要领料
|
||
' ========================================
|
||
Public Sub LoadData(wsConfig As Worksheet, wsPlatform As Worksheet)
|
||
Dim i As Long, lastRow As Long
|
||
Dim mat As clsMaterialItem
|
||
Dim cat As clsCategory
|
||
|
||
' ========================================
|
||
' 第一步: 从平台配置清单加载所有物料的基础信息
|
||
' 说明:
|
||
' - 读取C列(代号)、D列(名称)、E列(数量)、F列(选择条件)
|
||
' - 从第4行开始读取(前3行是标题)
|
||
' - 所有物料存入dictAllMaterials字典,以代号为键
|
||
' 目的: 建立完整的物料信息库,供后续按代号查询
|
||
' ========================================
|
||
lastRow = wsPlatform.Cells(wsPlatform.Rows.Count, "C").End(xlUp).row
|
||
For i = 4 To lastRow ' 从第4行开始(跳过标题)
|
||
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 & "") ' 选择条件
|
||
|
||
' 只保存代号非空的物料
|
||
If mat.code <> "" Then
|
||
Set dictAllMaterials(mat.code) = mat
|
||
End If
|
||
Next i
|
||
|
||
' ========================================
|
||
' 第二步: 从领料配置加载类别信息并建立层级
|
||
' 说明:
|
||
' - 读取A列(代号)、C列(类别)、D列(上层类别)
|
||
' - 从第2行开始读取(第1行是标题)
|
||
' - 只有出现在此表中的物料才需要领料
|
||
' 处理逻辑:
|
||
' 1. 为每个类别创建clsCategory对象
|
||
' 2. 从dictAllMaterials中查找对应的物料信息
|
||
' 3. 将物料添加到对应的类别中
|
||
' ========================================
|
||
lastRow = wsConfig.Cells(wsConfig.Rows.Count, "A").End(xlUp).row
|
||
For i = 2 To lastRow ' 从第2行开始
|
||
Dim code As String, catName As String, parentCatName As String
|
||
code = Trim(wsConfig.Cells(i, "A").value & "") ' 物料代号
|
||
catName = Trim(wsConfig.Cells(i, "C").value & "") ' 类别名称
|
||
parentCatName = Trim(wsConfig.Cells(i, "D").value & "") ' 上层类别名称
|
||
|
||
' 跳过空行
|
||
If code = "" Then GoTo NextRow
|
||
|
||
' 确保类别对象存在(如果类别不存在则创建)
|
||
If Not dictCategories.Exists(catName) Then
|
||
Set cat = New clsCategory
|
||
cat.categoryName = catName
|
||
cat.ParentCategoryName = parentCatName
|
||
Set dictCategories(catName) = cat
|
||
End If
|
||
|
||
' 将物料添加到类别
|
||
' 注意: 必须先在dictAllMaterials中查找到完整的物料信息
|
||
If dictAllMaterials.Exists(code) Then
|
||
Set mat = dictAllMaterials(code)
|
||
mat.Category = catName ' 设置物料所属类别
|
||
mat.ParentCategory = parentCatName ' 设置物料的上层类别
|
||
dictCategories(catName).AddMaterial mat ' 将物料添加到类别对象中
|
||
End If
|
||
|
||
NextRow:
|
||
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 方法
|
||
' 功能: 根据产品型号获取符合条件的物料清单
|
||
' 参数:
|
||
' modelStr - 产品型号字符串
|
||
' categoryName - 可选，指定类别名称。为空则返回所有类别的物料
|
||
' 返回: Collection对象，包含符合条件的clsMaterialItem对象
|
||
' 示例:
|
||
' Set materials = bomMgr.GetMaterialsByModel("YTHN-100.A0.532.M203.M16.Y3")
|
||
' Set materials = bomMgr.GetMaterialsByModel("YTHN-100.A0.532.M203.M16.Y3", "部件")
|
||
' ========================================
|
||
Public Function GetMaterialsByModel(modelStr As String, _
|
||
Optional categoryName As String = "") 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
|
||
|
||
' 2. 提取条件
|
||
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 ""
|
||
|
||
' 3. 创建条件匹配器
|
||
Dim matcher As New clsConditionMatcher
|
||
|
||
' 4. 获取要筛选的物料范围
|
||
Dim materialsToFilter As collection
|
||
Set materialsToFilter = New collection
|
||
|
||
If categoryName <> "" Then
|
||
' 指定类别：获取该类别的所有物料
|
||
Dim cat As clsCategory
|
||
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)
|
||
Next i
|
||
End If
|
||
Else
|
||
' 未指定类别：获取所有根类别的物料
|
||
Dim rootCat As clsCategory
|
||
Dim j As Long
|
||
For j = 1 To rootCategories.Count
|
||
Set rootCat = rootCategories(j)
|
||
' 递归获取所有物料
|
||
Call CollectAllMaterials(rootCat, materialsToFilter)
|
||
Next j
|
||
End If
|
||
|
||
' 5. 筛选符合条件的物料
|
||
Dim mat As clsMaterialItem
|
||
Dim matchCount As Long
|
||
matchCount = 0
|
||
|
||
For Each mat In materialsToFilter
|
||
' 使用条件匹配器判断
|
||
If matcher.IsMatch(mat.Condition, conditions) Then
|
||
result.Add mat
|
||
matchCount = matchCount + 1
|
||
|
||
' 调试输出
|
||
Debug.Print "【匹配】 " & mat.code & " - " & mat.Name & _
|
||
" | 条件: " & IIf(mat.Condition = "", "(无)", mat.Condition)
|
||
End If
|
||
Next mat
|
||
|
||
Debug.Print "共匹配 " & matchCount & " 个物料"
|
||
Debug.Print String(60, "=")
|
||
|
||
Set GetMaterialsByModel = 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
|
||
|
||
' ========================================
|
||
' 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 |