clear
This commit is contained in:
Misaka_Company
@@ -1,987 +0,0 @@
|
||||
' ========================================
|
||||
' 类模块: 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
|
||||
@@ -1,84 +0,0 @@
|
||||
' ========================================
|
||||
' 类模块: clsCategory
|
||||
' 用途: 表示物料类别及其层级关系
|
||||
' ========================================
|
||||
Option Explicit
|
||||
|
||||
Public categoryName As String
|
||||
Public ParentCategoryName As String
|
||||
Public materials As collection ' 存储 clsMaterialItem 对象
|
||||
Public SubCategories As collection ' 存储子类别 clsCategory 对象
|
||||
Public IsLeafCategory As Boolean ' 是否叶子类别(无子类别)
|
||||
Public CategorySelectCondition As String ' 类别选用条件（用于判断该类别是否需要）
|
||||
|
||||
Private Sub Class_Initialize()
|
||||
Set materials = New collection
|
||||
Set SubCategories = New collection
|
||||
IsLeafCategory = True
|
||||
End Sub
|
||||
|
||||
' 添加物料
|
||||
Public Sub AddMaterial(mat As clsMaterialItem)
|
||||
materials.Add mat, mat.code
|
||||
End Sub
|
||||
|
||||
' 添加子类别
|
||||
Public Sub AddSubCategory(cat As clsCategory)
|
||||
SubCategories.Add cat, cat.categoryName
|
||||
IsLeafCategory = False
|
||||
End Sub
|
||||
|
||||
' 获取物料(按代号)
|
||||
Public Function GetMaterial(code As String) As clsMaterialItem
|
||||
On Error Resume Next
|
||||
Set GetMaterial = materials(code)
|
||||
On Error GoTo 0
|
||||
End Function
|
||||
|
||||
' 检查是否有子类别
|
||||
Public Function HasSubCategories() As Boolean
|
||||
HasSubCategories = (SubCategories.Count > 0)
|
||||
End Function
|
||||
|
||||
' ========================================
|
||||
' IsRequiredForModel 方法
|
||||
' 功能: 根据型号条件判断该类别是否需要
|
||||
' 参数:
|
||||
' conditions - 从型号提取的条件字典 (Dictionary对象)
|
||||
' 返回:
|
||||
' True - 该类别需要
|
||||
' False - 该类别不需要
|
||||
'
|
||||
' 判断逻辑:
|
||||
' 1. 如果 CategorySelectCondition 为空字符串
|
||||
' → 该类别总是需要（无条件限制）
|
||||
' 2. 如果 CategorySelectCondition 不为空
|
||||
' → 使用 clsConditionMatcher 匹配条件
|
||||
' → 匹配成功 → 需要
|
||||
' → 匹配失败 → 不需要
|
||||
'
|
||||
' 示例:
|
||||
' 假设型号条件为: lcfw=M16, gclj=M20
|
||||
'
|
||||
' 情况1: CategorySelectCondition = ""
|
||||
' → IsRequiredForModel(conditions) = True
|
||||
'
|
||||
' 情况2: CategorySelectCondition = "lcfw=M16"
|
||||
' → IsRequiredForModel(conditions) = True (匹配)
|
||||
'
|
||||
' 情况3: CategorySelectCondition = "lcfw=M02"
|
||||
' → IsRequiredForModel(conditions) = False (不匹配)
|
||||
'
|
||||
' 情况4: CategorySelectCondition = "gclj=M20 AND jycz=1"
|
||||
' → IsRequiredForModel(conditions) = True (匹配)
|
||||
' ========================================
|
||||
Public Function IsRequiredForModel(conditions As Object) As Boolean
|
||||
If Me.CategorySelectCondition = "" Then
|
||||
' 选用条件为空，该类别总是需要
|
||||
IsRequiredForModel = True
|
||||
Else
|
||||
' 需要用 conditions 去匹配 CategorySelectCondition
|
||||
Dim matcher As New clsConditionMatcher
|
||||
IsRequiredForModel = matcher.IsMatch(Me.CategorySelectCondition, conditions)
|
||||
End If
|
||||
End Function
|
||||
@@ -1,243 +0,0 @@
|
||||
' ========================================
|
||||
' 类模块: clsConditionExtractor
|
||||
' 用途: 从型号解析器中提取物料选择条件
|
||||
' ========================================
|
||||
Option Explicit
|
||||
|
||||
' ========================================
|
||||
' 私有成员变量
|
||||
' ========================================
|
||||
Private m_Conditions As Object ' Dictionary: 变量名 -> 条件值
|
||||
Private m_ExtractionRules As Object ' Dictionary: 提取规则配置
|
||||
|
||||
' ========================================
|
||||
' 类初始化
|
||||
' ========================================
|
||||
Private Sub Class_Initialize()
|
||||
Set m_Conditions = CreateObject("Scripting.Dictionary")
|
||||
Set m_ExtractionRules = CreateObject("Scripting.Dictionary")
|
||||
|
||||
' 初始化提取规则
|
||||
InitializeRules
|
||||
End Sub
|
||||
|
||||
' ========================================
|
||||
' InitializeRules 方法 (私有)
|
||||
' 功能: 初始化条件提取规则
|
||||
' 说明: 这里配置所有需要提取的条件及其提取方法
|
||||
' ========================================
|
||||
Private Sub InitializeRules()
|
||||
' 规则格式: Dictionary(变量名) = Array(源字段, 提取方法)
|
||||
|
||||
' 规则1: 过程连接 (gclj)
|
||||
' 从 ConnectionCode 中提取，去掉最后一位数字
|
||||
m_ExtractionRules("gclj") = Array("ConnectionCode", "RemoveLastDigit")
|
||||
|
||||
' 规则2: 接液材质 (jycz)
|
||||
' 从 ConnectionCode 中提取，取最后一位数字
|
||||
m_ExtractionRules("jycz") = Array("ConnectionCode", "GetLastDigit")
|
||||
|
||||
' 规则3: 量程范围 (lcfw)
|
||||
' 从 RangeCode 中直接提取
|
||||
m_ExtractionRules("lcfw") = Array("RangeCode", "Direct")
|
||||
|
||||
' 规则4: 安装形式 (azxs)
|
||||
' 从 InstallForm 中直接提取（例如：A0=径向无边, Z0=中轴向无边）
|
||||
m_ExtractionRules("azxs") = Array("InstallForm", "Direct")
|
||||
|
||||
' 规则5: 表壳形式 (bkxs)
|
||||
' 从 ShellForm 中直接提取（3位代码：前2位表壳类型+后1位罩壳类型）
|
||||
' 例如：532 = 53(304外壳、安装式) + 2(外卡式)
|
||||
m_ExtractionRules("bkxs") = Array("ShellForm", "Direct")
|
||||
|
||||
' 未来可以在这里添加更多提取规则...
|
||||
' 例如:
|
||||
' m_ExtractionRules("bplx") = Array("DialCode", "Direct") ' 表盘类型
|
||||
End Sub
|
||||
|
||||
' ========================================
|
||||
' ExtractConditions 方法
|
||||
' 功能: 从型号解析器中提取所有条件
|
||||
' 参数: parser - clsModelParser对象
|
||||
' 返回: Dictionary对象，包含所有提取的条件
|
||||
' ========================================
|
||||
Public Function ExtractConditions(parser As clsModelParser) As Object
|
||||
' 清空现有条件
|
||||
Set m_Conditions = CreateObject("Scripting.Dictionary")
|
||||
|
||||
' 验证解析器有效性
|
||||
If Not parser.IsValid Then
|
||||
Set ExtractConditions = m_Conditions
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' 遍历所有提取规则
|
||||
Dim varName As Variant
|
||||
For Each varName In m_ExtractionRules.Keys
|
||||
Dim ruleInfo As Variant
|
||||
ruleInfo = m_ExtractionRules(varName)
|
||||
|
||||
Dim sourceField As String
|
||||
Dim extractMethod As String
|
||||
sourceField = ruleInfo(0)
|
||||
extractMethod = ruleInfo(1)
|
||||
|
||||
' 提取条件值
|
||||
Dim conditionValue As String
|
||||
conditionValue = ExtractValue(parser, sourceField, extractMethod)
|
||||
|
||||
' 添加到条件字典
|
||||
If conditionValue <> "" Then
|
||||
m_Conditions(CStr(varName)) = conditionValue
|
||||
End If
|
||||
Next varName
|
||||
|
||||
Set ExtractConditions = m_Conditions
|
||||
End Function
|
||||
|
||||
' ========================================
|
||||
' ExtractValue 方法 (私有)
|
||||
' 功能: 根据规则从解析器中提取单个值
|
||||
' 参数:
|
||||
' parser - clsModelParser对象
|
||||
' sourceField - 源字段名称
|
||||
' extractMethod - 提取方法名称
|
||||
' 返回: 提取的条件值
|
||||
' ========================================
|
||||
Private Function ExtractValue(parser As clsModelParser, _
|
||||
sourceField As String, _
|
||||
extractMethod As String) As String
|
||||
Dim sourceValue As String
|
||||
|
||||
' 获取源字段值
|
||||
Select Case sourceField
|
||||
Case "ConnectionCode"
|
||||
sourceValue = parser.ConnectionCode
|
||||
Case "RangeCode"
|
||||
sourceValue = parser.RangeCode
|
||||
Case "ModelType"
|
||||
sourceValue = parser.ModelType
|
||||
Case "Diameter"
|
||||
sourceValue = parser.Diameter
|
||||
Case "InstallForm"
|
||||
sourceValue = parser.InstallForm
|
||||
Case "ShellForm"
|
||||
sourceValue = parser.ShellForm
|
||||
Case "Characteristics"
|
||||
sourceValue = parser.Characteristics
|
||||
Case Else
|
||||
sourceValue = ""
|
||||
End Select
|
||||
|
||||
' 应用提取方法
|
||||
Select Case extractMethod
|
||||
Case "Direct"
|
||||
' 直接使用
|
||||
ExtractValue = sourceValue
|
||||
|
||||
Case "RemoveLastDigit"
|
||||
' 去掉最后一位字符
|
||||
If Len(sourceValue) > 1 Then
|
||||
ExtractValue = Left(sourceValue, Len(sourceValue) - 1)
|
||||
Else
|
||||
ExtractValue = sourceValue
|
||||
End If
|
||||
|
||||
Case "GetLastDigit"
|
||||
' 取最后一位字符
|
||||
If Len(sourceValue) > 0 Then
|
||||
ExtractValue = Right(sourceValue, 1)
|
||||
Else
|
||||
ExtractValue = ""
|
||||
End If
|
||||
|
||||
Case "GetFirstChar"
|
||||
' 取第一个字符
|
||||
If Len(sourceValue) > 0 Then
|
||||
ExtractValue = Left(sourceValue, 1)
|
||||
Else
|
||||
ExtractValue = ""
|
||||
End If
|
||||
|
||||
Case Else
|
||||
' 未知方法，返回空
|
||||
ExtractValue = ""
|
||||
End Select
|
||||
End Function
|
||||
|
||||
' ========================================
|
||||
' GetConditionValue 方法
|
||||
' 功能: 获取单个条件值
|
||||
' 参数: varName - 变量名
|
||||
' 返回: 条件值，如果不存在返回空字符串
|
||||
' ========================================
|
||||
Public Function GetConditionValue(varName As String) As String
|
||||
If m_Conditions.Exists(varName) Then
|
||||
GetConditionValue = m_Conditions(varName)
|
||||
Else
|
||||
GetConditionValue = ""
|
||||
End If
|
||||
End Function
|
||||
|
||||
' ========================================
|
||||
' AddCondition 方法
|
||||
' 功能: 手动添加条件 (用于特殊情况)
|
||||
' 参数:
|
||||
' varName - 变量名
|
||||
' value - 条件值
|
||||
' ========================================
|
||||
Public Sub AddCondition(varName As String, value As String)
|
||||
m_Conditions(varName) = value
|
||||
End Sub
|
||||
|
||||
' ========================================
|
||||
' GetConditions 属性
|
||||
' 功能: 获取所有条件的Dictionary对象
|
||||
' ========================================
|
||||
Public Property Get conditions() As Object
|
||||
Set conditions = m_Conditions
|
||||
End Property
|
||||
|
||||
' ========================================
|
||||
' ToString 方法
|
||||
' 功能: 返回条件的字符串表示 (用于调试)
|
||||
' ========================================
|
||||
Public Function ToString() As String
|
||||
Dim result As String
|
||||
result = "【提取的条件】" & vbCrLf
|
||||
|
||||
If m_Conditions.Count = 0 Then
|
||||
result = result & " (无条件)" & vbCrLf
|
||||
Else
|
||||
Dim key As Variant
|
||||
For Each key In m_Conditions.Keys
|
||||
result = result & " " & key & " = " & m_Conditions(key) & vbCrLf
|
||||
Next key
|
||||
End If
|
||||
|
||||
ToString = result
|
||||
End Function
|
||||
|
||||
' ========================================
|
||||
' AddExtractionRule 方法
|
||||
' 功能: 动态添加新的提取规则 (用于扩展)
|
||||
' 参数:
|
||||
' varName - 变量名
|
||||
' sourceField - 源字段名称
|
||||
' extractMethod - 提取方法名称
|
||||
' 示例: extractor.AddExtractionRule "bplx", "DialCode", "Direct"
|
||||
' ========================================
|
||||
Public Sub AddExtractionRule(varName As String, _
|
||||
sourceField As String, _
|
||||
extractMethod As String)
|
||||
m_ExtractionRules(varName) = Array(sourceField, extractMethod)
|
||||
End Sub
|
||||
|
||||
' ========================================
|
||||
' GetExtractionRules 方法
|
||||
' 功能: 获取当前所有提取规则 (用于调试)
|
||||
' 返回: Dictionary对象
|
||||
' ========================================
|
||||
Public Function GetExtractionRules() As Object
|
||||
Set GetExtractionRules = m_ExtractionRules
|
||||
End Function
|
||||
@@ -1,250 +0,0 @@
|
||||
' ========================================
|
||||
' 类模块: clsConditionMatcher
|
||||
' 用途: 解析物料的选择条件表达式，并判断是否匹配
|
||||
' 支持: AND, OR, NOT(!=), 括号优先级
|
||||
' ========================================
|
||||
Option Explicit
|
||||
|
||||
' ========================================
|
||||
' IsMatch 方法
|
||||
' 功能: 判断条件表达式是否匹配
|
||||
' 参数:
|
||||
' conditionExpr - 条件表达式字符串
|
||||
' conditions - Dictionary对象，包含变量名->值的映射
|
||||
' 返回: Boolean - 是否匹配
|
||||
' 示例:
|
||||
' IsMatch("lcfw=M16 AND gclj=M20", conditions) -> True/False
|
||||
' ========================================
|
||||
Public Function IsMatch(conditionExpr As String, conditions As Object) As Boolean
|
||||
On Error GoTo ErrorHandler
|
||||
|
||||
' 空条件表示无条件，始终匹配
|
||||
If Trim(conditionExpr) = "" Then
|
||||
IsMatch = True
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' 解析并计算表达式
|
||||
IsMatch = EvaluateExpression(Trim(conditionExpr), conditions)
|
||||
Exit Function
|
||||
|
||||
ErrorHandler:
|
||||
' 出错时返回False（保守处理）
|
||||
Debug.Print "条件匹配出错: " & conditionExpr & " - " & Err.description
|
||||
IsMatch = False
|
||||
End Function
|
||||
|
||||
' ========================================
|
||||
' EvaluateExpression 方法 (私有)
|
||||
' 功能: 递归计算逻辑表达式
|
||||
' 优先级: 括号 > NOT(!=) > AND > OR
|
||||
' ========================================
|
||||
Private Function EvaluateExpression(expr As String, conditions As Object) As Boolean
|
||||
expr = Trim(expr)
|
||||
|
||||
' 处理括号 (最高优先级)
|
||||
If InStr(expr, "(") > 0 Then
|
||||
EvaluateExpression = EvaluateWithParentheses(expr, conditions)
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' 处理 OR (最低优先级)
|
||||
If InStr(expr, " OR ") > 0 Then
|
||||
EvaluateExpression = EvaluateOR(expr, conditions)
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' 处理 AND (中等优先级)
|
||||
If InStr(expr, " AND ") > 0 Then
|
||||
EvaluateExpression = EvaluateAND(expr, conditions)
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' 处理单个条件 (最高优先级)
|
||||
EvaluateExpression = EvaluateSimpleCondition(expr, conditions)
|
||||
End Function
|
||||
|
||||
' ========================================
|
||||
' EvaluateWithParentheses 方法 (私有)
|
||||
' 功能: 处理包含括号的表达式
|
||||
' 策略: 找到最内层括号，递归计算，然后替换为结果
|
||||
' ========================================
|
||||
Private Function EvaluateWithParentheses(expr As String, conditions As Object) As Boolean
|
||||
Dim pos As Long, level As Long, startPos As Long
|
||||
Dim i As Long
|
||||
Dim innerExpr As String
|
||||
Dim innerResult As Boolean
|
||||
Dim newExpr As String
|
||||
|
||||
' 查找最内层的括号对
|
||||
startPos = 0
|
||||
level = 0
|
||||
|
||||
For i = 1 To Len(expr)
|
||||
If Mid(expr, i, 1) = "(" Then
|
||||
If level = 0 Then startPos = i
|
||||
level = level + 1
|
||||
ElseIf Mid(expr, i, 1) = ")" Then
|
||||
level = level - 1
|
||||
If level = 0 And startPos > 0 Then
|
||||
' 找到一对括号
|
||||
innerExpr = Mid(expr, startPos + 1, i - startPos - 1)
|
||||
innerResult = EvaluateExpression(innerExpr, conditions)
|
||||
|
||||
' 替换括号部分为结果
|
||||
newExpr = Left(expr, startPos - 1) & _
|
||||
IIf(innerResult, "TRUE", "FALSE") & _
|
||||
Mid(expr, i + 1)
|
||||
|
||||
' 递归处理剩余部分
|
||||
EvaluateWithParentheses = EvaluateExpression(newExpr, conditions)
|
||||
Exit Function
|
||||
End If
|
||||
End If
|
||||
Next i
|
||||
|
||||
' 如果没有找到有效括号，直接计算
|
||||
EvaluateWithParentheses = EvaluateExpression(expr, conditions)
|
||||
End Function
|
||||
|
||||
' ========================================
|
||||
' EvaluateOR 方法 (私有)
|
||||
' 功能: 处理 OR 逻辑运算
|
||||
' 规则: 任一为真则为真
|
||||
' ========================================
|
||||
Private Function EvaluateOR(expr As String, conditions As Object) As Boolean
|
||||
Dim parts() As String
|
||||
Dim part As Variant
|
||||
|
||||
' 按 OR 分割
|
||||
parts = Split(expr, " OR ")
|
||||
|
||||
' 任一部分为真则返回真
|
||||
For Each part In parts
|
||||
If EvaluateExpression(Trim(CStr(part)), conditions) Then
|
||||
EvaluateOR = True
|
||||
Exit Function
|
||||
End If
|
||||
Next part
|
||||
|
||||
EvaluateOR = False
|
||||
End Function
|
||||
|
||||
' ========================================
|
||||
' EvaluateAND 方法 (私有)
|
||||
' 功能: 处理 AND 逻辑运算
|
||||
' 规则: 全部为真才为真
|
||||
' ========================================
|
||||
Private Function EvaluateAND(expr As String, conditions As Object) As Boolean
|
||||
Dim parts() As String
|
||||
Dim part As Variant
|
||||
|
||||
' 按 AND 分割
|
||||
parts = Split(expr, " AND ")
|
||||
|
||||
' 全部部分为真才返回真
|
||||
For Each part In parts
|
||||
If Not EvaluateExpression(Trim(CStr(part)), conditions) Then
|
||||
EvaluateAND = False
|
||||
Exit Function
|
||||
End If
|
||||
Next part
|
||||
|
||||
EvaluateAND = True
|
||||
End Function
|
||||
|
||||
' ========================================
|
||||
' EvaluateSimpleCondition 方法 (私有)
|
||||
' 功能: 计算单个条件表达式
|
||||
' 支持: = (等于), != (不等于)
|
||||
' 格式: varName=value 或 varName!=value
|
||||
' ========================================
|
||||
Private Function EvaluateSimpleCondition(cond As String, conditions As Object) As Boolean
|
||||
cond = Trim(cond)
|
||||
|
||||
' 处理特殊值 TRUE/FALSE (括号计算的结果)
|
||||
If UCase(cond) = "TRUE" Then
|
||||
EvaluateSimpleCondition = True
|
||||
Exit Function
|
||||
ElseIf UCase(cond) = "FALSE" Then
|
||||
EvaluateSimpleCondition = False
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
Dim varName As String
|
||||
Dim expectedValue As String
|
||||
Dim actualValue As String
|
||||
Dim isNotEqual As Boolean
|
||||
|
||||
' 判断是 != 还是 =
|
||||
If InStr(cond, "!=") > 0 Then
|
||||
isNotEqual = True
|
||||
Dim parts1() As String
|
||||
parts1 = Split(cond, "!=")
|
||||
If UBound(parts1) < 1 Then
|
||||
EvaluateSimpleCondition = False
|
||||
Exit Function
|
||||
End If
|
||||
varName = Trim(parts1(0))
|
||||
expectedValue = Trim(parts1(1))
|
||||
ElseIf InStr(cond, "=") > 0 Then
|
||||
isNotEqual = False
|
||||
Dim parts2() As String
|
||||
parts2 = Split(cond, "=")
|
||||
If UBound(parts2) < 1 Then
|
||||
EvaluateSimpleCondition = False
|
||||
Exit Function
|
||||
End If
|
||||
varName = Trim(parts2(0))
|
||||
expectedValue = Trim(parts2(1))
|
||||
Else
|
||||
' 无效的条件格式
|
||||
EvaluateSimpleCondition = False
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' 获取实际值
|
||||
If conditions.Exists(varName) Then
|
||||
actualValue = Trim(CStr(conditions(varName)))
|
||||
Else
|
||||
actualValue = ""
|
||||
End If
|
||||
|
||||
' 比较值 (不区分大小写)
|
||||
Dim isEqual As Boolean
|
||||
isEqual = (UCase(actualValue) = UCase(expectedValue))
|
||||
|
||||
' 返回结果
|
||||
If isNotEqual Then
|
||||
EvaluateSimpleCondition = Not isEqual
|
||||
Else
|
||||
EvaluateSimpleCondition = isEqual
|
||||
End If
|
||||
End Function
|
||||
|
||||
' ========================================
|
||||
' TestExpression 方法
|
||||
' 功能: 测试表达式是否有效 (用于调试)
|
||||
' 参数: expr - 表达式字符串
|
||||
' 返回: String - "有效" 或 错误信息
|
||||
' ========================================
|
||||
Public Function TestExpression(expr As String) As String
|
||||
On Error GoTo ErrorHandler
|
||||
|
||||
' 创建测试条件
|
||||
Dim testConditions As Object
|
||||
Set testConditions = CreateObject("Scripting.Dictionary")
|
||||
testConditions("gclj") = "M20"
|
||||
testConditions("jycz") = "3"
|
||||
testConditions("lcfw") = "M16"
|
||||
|
||||
' 尝试计算
|
||||
Dim result As Boolean
|
||||
result = IsMatch(expr, testConditions)
|
||||
|
||||
TestExpression = "有效 (结果: " & IIf(result, "True", "False") & ")"
|
||||
Exit Function
|
||||
|
||||
ErrorHandler:
|
||||
TestExpression = "无效: " & Err.description
|
||||
End Function
|
||||
@@ -1,14 +0,0 @@
|
||||
' ========================================
|
||||
' 类模块: clsMaterialItem
|
||||
' 用途: 表示单个物料项
|
||||
' ========================================
|
||||
Option Explicit
|
||||
|
||||
Public code As String ' 代号
|
||||
Public Name As String ' 名称
|
||||
Public Quantity As Double ' 数量
|
||||
Public Condition As String ' 选择条件
|
||||
Public Category As String ' 类别
|
||||
Public ParentCategory As String ' 上层类别
|
||||
Public CategorySelectCondition As String ' 类别选用条件（用于判断该类别是否需要）
|
||||
Public Code66 As String ' 66系统代码
|
||||
@@ -1,34 +0,0 @@
|
||||
' ========================================
|
||||
' 类模块: clsMaterialWithFlag
|
||||
' 用途: 包装物料对象及其匹配状态标志
|
||||
' ========================================
|
||||
Option Explicit
|
||||
|
||||
Private mMaterial As clsMaterialItem ' 物料对象
|
||||
Private mIsComplete As Boolean ' 是否完整匹配
|
||||
|
||||
' ========================================
|
||||
' 属性: Material
|
||||
' 说明: 获取或设置物料对象
|
||||
' ========================================
|
||||
Public Property Get Material() As clsMaterialItem
|
||||
Set Material = mMaterial
|
||||
End Property
|
||||
|
||||
Public Property Set Material(ByVal value As clsMaterialItem)
|
||||
Set mMaterial = value
|
||||
End Property
|
||||
|
||||
' ========================================
|
||||
' 属性: IsComplete
|
||||
' 说明: 获取或设置是否完整匹配
|
||||
' True: 该物料属于完整的物料清单
|
||||
' False: 该物料属于不完整的物料清单（某些类别缺失物料）
|
||||
' ========================================
|
||||
Public Property Get isComplete() As Boolean
|
||||
isComplete = mIsComplete
|
||||
End Property
|
||||
|
||||
Public Property Let isComplete(ByVal value As Boolean)
|
||||
mIsComplete = value
|
||||
End Property
|
||||
@@ -1,229 +0,0 @@
|
||||
' ========================================
|
||||
' 类模块: clsModelParser
|
||||
' 用途: 解析产品型号，提取各部分代码
|
||||
' 示例: YTHN-100.A0.532.M203.M16.Y3|BP-095.2312.M16.PA3
|
||||
' ========================================
|
||||
Option Explicit
|
||||
|
||||
' ========================================
|
||||
' 公共属性
|
||||
' ========================================
|
||||
Public RawModel As String ' 原始完整型号
|
||||
Public HeaderModel As String ' 表头型号部分
|
||||
Public DialModel As String ' 表盘型号部分
|
||||
Public AccessoryModel As String ' 附件型号部分
|
||||
Public FlangeModel As String ' 法兰隔膜型号部分
|
||||
|
||||
' 表头各部分
|
||||
Public ModelType As String ' 型号 (如 YTHN)
|
||||
Public Diameter As String ' 公称外径 (如 100)
|
||||
Public InstallForm As String ' 安装形式 (如 A0)
|
||||
Public ShellForm As String ' 壳体形式 (如 532)
|
||||
Public ConnectionCode As String ' 过程连接&材质代码 (如 M203)
|
||||
Public RangeCode As String ' 量程范围代码 (如 M16)
|
||||
Public Characteristics As String ' 仪表特性 (如 Y3)
|
||||
|
||||
' ========================================
|
||||
' 私有变量
|
||||
' ========================================
|
||||
Private m_IsValid As Boolean ' 解析是否成功
|
||||
Private m_ErrorMessage As String ' 错误信息
|
||||
|
||||
' ========================================
|
||||
' ParseModel 方法
|
||||
' 功能: 解析产品型号字符串
|
||||
' 参数: modelStr - 完整的产品型号字符串
|
||||
' 返回: Boolean - 解析是否成功
|
||||
' 示例: parser.ParseModel("YTHN-100.A0.532.M203.M16.Y3|BP-095.2312.M16.PA3")
|
||||
' ========================================
|
||||
Public Function ParseModel(modelStr As String) As Boolean
|
||||
On Error GoTo ErrorHandler
|
||||
|
||||
' 初始化
|
||||
m_IsValid = False
|
||||
m_ErrorMessage = ""
|
||||
RawModel = Trim(modelStr)
|
||||
|
||||
' 验证输入
|
||||
If RawModel = "" Then
|
||||
m_ErrorMessage = "型号字符串为空"
|
||||
ParseModel = False
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' 第一步: 按 | 分割各部分
|
||||
Dim parts() As String
|
||||
parts = Split(RawModel, "|")
|
||||
|
||||
If UBound(parts) >= 0 Then HeaderModel = Trim(parts(0))
|
||||
If UBound(parts) >= 1 Then DialModel = Trim(parts(1))
|
||||
If UBound(parts) >= 2 Then AccessoryModel = Trim(parts(2))
|
||||
If UBound(parts) >= 3 Then FlangeModel = Trim(parts(3))
|
||||
|
||||
' 第二步: 解析表头部分 (必须存在)
|
||||
If HeaderModel = "" Then
|
||||
m_ErrorMessage = "表头型号为空"
|
||||
ParseModel = False
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' 解析表头
|
||||
If Not ParseHeader(HeaderModel) Then
|
||||
ParseModel = False
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
m_IsValid = True
|
||||
ParseModel = True
|
||||
Exit Function
|
||||
|
||||
ErrorHandler:
|
||||
m_ErrorMessage = "解析出错: " & Err.description
|
||||
m_IsValid = False
|
||||
ParseModel = False
|
||||
End Function
|
||||
|
||||
' ========================================
|
||||
' ParseHeader 方法 (私有)
|
||||
' 功能: 解析表头型号部分
|
||||
' 格式: [型号]-[公称外径].[安装形式].[壳体形式].[过程连接&材质].[量程范围].[仪表特性]
|
||||
' 示例: YTHN-100.A0.532.M203.M16.Y3
|
||||
' ========================================
|
||||
Private Function ParseHeader(headerStr As String) As Boolean
|
||||
On Error GoTo ErrorHandler
|
||||
|
||||
' 按 - 分割型号和参数部分
|
||||
Dim mainParts() As String
|
||||
mainParts = Split(headerStr, "-")
|
||||
|
||||
If UBound(mainParts) < 1 Then
|
||||
m_ErrorMessage = "表头格式错误: 缺少 - 分隔符"
|
||||
ParseHeader = False
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' 提取型号
|
||||
ModelType = Trim(mainParts(0))
|
||||
|
||||
' 按 . 分割参数部分
|
||||
Dim params() As String
|
||||
params = Split(mainParts(1), ".")
|
||||
|
||||
' 验证参数数量 (至少应该有5个部分)
|
||||
If UBound(params) < 4 Then
|
||||
m_ErrorMessage = "表头参数不足: 需要至少5个参数段"
|
||||
ParseHeader = False
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' 提取各参数
|
||||
Diameter = Trim(params(0)) ' 公称外径
|
||||
InstallForm = Trim(params(1)) ' 安装形式
|
||||
ShellForm = Trim(params(2)) ' 壳体形式
|
||||
ConnectionCode = Trim(params(3)) ' 过程连接&材质
|
||||
RangeCode = Trim(params(4)) ' 量程范围
|
||||
|
||||
' 仪表特性 (可选)
|
||||
If UBound(params) >= 5 Then
|
||||
Characteristics = Trim(params(5))
|
||||
Else
|
||||
Characteristics = ""
|
||||
End If
|
||||
|
||||
ParseHeader = True
|
||||
Exit Function
|
||||
|
||||
ErrorHandler:
|
||||
m_ErrorMessage = "解析表头出错: " & Err.description
|
||||
ParseHeader = False
|
||||
End Function
|
||||
|
||||
' ========================================
|
||||
' GetThreadCode 方法
|
||||
' 功能: 从过程连接代码中提取螺纹代码
|
||||
' 规则: 去掉最后一位数字
|
||||
' 示例: M203 -> M20
|
||||
' ========================================
|
||||
Public Function GetThreadCode() As String
|
||||
If ConnectionCode = "" Then
|
||||
GetThreadCode = ""
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' 去掉最后一位字符 (假设最后一位是材质代码)
|
||||
If Len(ConnectionCode) > 1 Then
|
||||
GetThreadCode = Left(ConnectionCode, Len(ConnectionCode) - 1)
|
||||
Else
|
||||
GetThreadCode = ConnectionCode
|
||||
End If
|
||||
End Function
|
||||
|
||||
' ========================================
|
||||
' GetMaterialCode 方法
|
||||
' 功能: 从过程连接代码中提取材质代码
|
||||
' 规则: 取最后一位数字
|
||||
' 示例: M203 -> 3
|
||||
' ========================================
|
||||
Public Function GetMaterialCode() As String
|
||||
If ConnectionCode = "" Then
|
||||
GetMaterialCode = ""
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' 取最后一位字符
|
||||
GetMaterialCode = Right(ConnectionCode, 1)
|
||||
End Function
|
||||
|
||||
' ========================================
|
||||
' GetRangeCode 方法
|
||||
' 功能: 获取量程代码
|
||||
' 规则: 直接返回
|
||||
' 示例: M16 -> M16
|
||||
' ========================================
|
||||
Public Function GetRangeCode() As String
|
||||
GetRangeCode = RangeCode
|
||||
End Function
|
||||
|
||||
' ========================================
|
||||
' IsValid 属性
|
||||
' 功能: 返回解析是否成功
|
||||
' ========================================
|
||||
Public Property Get IsValid() As Boolean
|
||||
IsValid = m_IsValid
|
||||
End Property
|
||||
|
||||
' ========================================
|
||||
' ErrorMessage 属性
|
||||
' 功能: 返回错误信息
|
||||
' ========================================
|
||||
Public Property Get ErrorMessage() As String
|
||||
ErrorMessage = m_ErrorMessage
|
||||
End Property
|
||||
|
||||
' ========================================
|
||||
' ToString 方法
|
||||
' 功能: 返回解析结果的字符串表示 (用于调试)
|
||||
' ========================================
|
||||
Public Function ToString() As String
|
||||
Dim result As String
|
||||
result = "【型号解析结果】" & vbCrLf
|
||||
result = result & "原始型号: " & RawModel & vbCrLf
|
||||
result = result & "表头型号: " & HeaderModel & vbCrLf
|
||||
result = result & "表盘型号: " & DialModel & vbCrLf
|
||||
result = result & vbCrLf
|
||||
result = result & "【表头各部分】" & vbCrLf
|
||||
result = result & " 型号: " & ModelType & vbCrLf
|
||||
result = result & " 公称外径: " & Diameter & vbCrLf
|
||||
result = result & " 安装形式: " & InstallForm & vbCrLf
|
||||
result = result & " 壳体形式: " & ShellForm & vbCrLf
|
||||
result = result & " 过程连接&材质: " & ConnectionCode & vbCrLf
|
||||
result = result & " 量程范围: " & RangeCode & vbCrLf
|
||||
result = result & " 仪表特性: " & Characteristics & vbCrLf
|
||||
result = result & vbCrLf
|
||||
result = result & "【提取代码】" & vbCrLf
|
||||
result = result & " 螺纹代码: " & GetThreadCode() & vbCrLf
|
||||
result = result & " 材质代码: " & GetMaterialCode() & vbCrLf
|
||||
result = result & " 量程代码: " & GetRangeCode() & vbCrLf
|
||||
|
||||
ToString = result
|
||||
End Function
|
||||
@@ -1,178 +0,0 @@
|
||||
' ========================================
|
||||
' 模块: modBOMProcessor
|
||||
' 用途: BOM处理和操作示例
|
||||
' ⭐ v2.0 更新：所有过程使用新的 LoadData(wsPlatform) 接口
|
||||
' ========================================
|
||||
Option Explicit
|
||||
|
||||
Sub TestBOMStructure()
|
||||
' 初始化BOM管理器
|
||||
Dim bomMgr As New clsBOMManager
|
||||
|
||||
' 加载数据
|
||||
Dim wsPlatform As Worksheet
|
||||
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
|
||||
|
||||
' ⭐ 使用新接口
|
||||
bomMgr.LoadData wsPlatform
|
||||
|
||||
' 打印类别树结构到新工作表
|
||||
Dim wsOutput As Worksheet
|
||||
On Error Resume Next
|
||||
Application.DisplayAlerts = False
|
||||
ThisWorkbook.Worksheets("BOM结构").Delete
|
||||
Application.DisplayAlerts = True
|
||||
On Error GoTo 0
|
||||
|
||||
Set wsOutput = ThisWorkbook.Worksheets.Add
|
||||
wsOutput.Name = "BOM结构"
|
||||
|
||||
'bomMgr.PrintCategoryTree wsOutput
|
||||
|
||||
Dim cats As collection
|
||||
Dim i As Integer
|
||||
Set cats = bomMgr.GetRootCategories()
|
||||
For i = 1 To cats.Count
|
||||
Debug.Print cats(i).categoryName
|
||||
Next i
|
||||
|
||||
|
||||
|
||||
MsgBox "BOM数据结构加载完成!" & vbCrLf & _
|
||||
"请查看 'BOM结构' 工作表", vbInformation
|
||||
End Sub
|
||||
|
||||
' 示例: 获取特定类别的物料
|
||||
Sub GetCategoryMaterials()
|
||||
Dim bomMgr As New clsBOMManager
|
||||
Dim wsPlatform As Worksheet
|
||||
|
||||
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
|
||||
|
||||
' ⭐ 使用新接口
|
||||
bomMgr.LoadData wsPlatform
|
||||
|
||||
' 获取"部件"类别的物料(使用父类别)
|
||||
Dim materials As collection
|
||||
Set materials = bomMgr.GetMaterialsForPicking("部件", True)
|
||||
|
||||
Debug.Print "部件类别物料数量(父类别): " & materials.Count
|
||||
|
||||
' 获取"部件"类别的物料(使用子类别)
|
||||
Set materials = bomMgr.GetMaterialsForPicking("部件", False)
|
||||
|
||||
Debug.Print "部件类别物料数量(子类别展开): " & materials.Count
|
||||
|
||||
' 遍历物料
|
||||
Dim mat As clsMaterialItem
|
||||
For Each mat In materials
|
||||
Debug.Print mat.code & " - " & mat.Name & _
|
||||
" | 数量:" & mat.Quantity & _
|
||||
" | 条件:" & mat.Condition
|
||||
Next mat
|
||||
End Sub
|
||||
|
||||
' 示例: 根据产品型号生成领料清单
|
||||
Sub GeneratePickingList()
|
||||
Dim bomMgr As New clsBOMManager
|
||||
Dim wsPlatform As Worksheet
|
||||
|
||||
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
|
||||
|
||||
' ⭐ 使用新接口
|
||||
bomMgr.LoadData wsPlatform
|
||||
|
||||
' 创建领料清单工作表
|
||||
Dim wsPickList As Worksheet
|
||||
On Error Resume Next
|
||||
Application.DisplayAlerts = False
|
||||
ThisWorkbook.Worksheets("领料清单").Delete
|
||||
Application.DisplayAlerts = True
|
||||
On Error GoTo 0
|
||||
|
||||
Set wsPickList = ThisWorkbook.Worksheets.Add
|
||||
wsPickList.Name = "领料清单"
|
||||
|
||||
' 写入表头
|
||||
Dim row As Long
|
||||
row = 1
|
||||
wsPickList.Cells(row, 1).value = "代号"
|
||||
wsPickList.Cells(row, 2).value = "名称"
|
||||
wsPickList.Cells(row, 3).value = "类别"
|
||||
wsPickList.Cells(row, 4).value = "数量"
|
||||
wsPickList.Cells(row, 5).value = "选择条件"
|
||||
wsPickList.Cells(row, 6).value = "领料方式"
|
||||
row = row + 1
|
||||
|
||||
' 遍历所有根类别
|
||||
Dim rootCats As collection
|
||||
Set rootCats = bomMgr.GetRootCategories
|
||||
|
||||
Dim cat As clsCategory
|
||||
Dim materials As collection
|
||||
Dim mat As clsMaterialItem
|
||||
Dim i As Long, j As Long
|
||||
|
||||
For i = 1 To rootCats.Count
|
||||
Set cat = rootCats(i)
|
||||
' 默认使用父类别物料
|
||||
Set materials = bomMgr.GetMaterialsForPicking(cat.categoryName, True)
|
||||
|
||||
For j = 1 To materials.Count
|
||||
Set mat = materials(j)
|
||||
wsPickList.Cells(row, 1).value = mat.code
|
||||
wsPickList.Cells(row, 2).value = mat.Name
|
||||
wsPickList.Cells(row, 3).value = mat.Category
|
||||
wsPickList.Cells(row, 4).value = mat.Quantity
|
||||
wsPickList.Cells(row, 5).value = mat.Condition
|
||||
wsPickList.Cells(row, 6).value = "父类别"
|
||||
row = row + 1
|
||||
Next j
|
||||
Next i
|
||||
|
||||
' 格式化表格
|
||||
wsPickList.Range("A1:F1").Font.Bold = True
|
||||
wsPickList.Columns("A:F").AutoFit
|
||||
|
||||
MsgBox "领料清单生成完成!", vbInformation
|
||||
End Sub
|
||||
|
||||
' 示例: 查询特定物料信息
|
||||
Sub QueryMaterialInfo()
|
||||
Dim bomMgr As New clsBOMManager
|
||||
Dim wsPlatform As Worksheet
|
||||
|
||||
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
|
||||
|
||||
' ⭐ 使用新接口
|
||||
bomMgr.LoadData wsPlatform
|
||||
|
||||
' 查询特定类别
|
||||
Dim cat As clsCategory
|
||||
Set cat = bomMgr.GetCategory("部件")
|
||||
|
||||
If Not cat Is Nothing Then
|
||||
Debug.Print "类别: " & cat.categoryName
|
||||
Debug.Print "父类别: " & cat.ParentCategoryName
|
||||
Debug.Print "物料数: " & cat.materials.Count
|
||||
Debug.Print "子类别数: " & cat.SubCategories.Count
|
||||
Debug.Print "是否叶子类别: " & cat.IsLeafCategory
|
||||
|
||||
' 列出所有物料
|
||||
Dim mat As clsMaterialItem
|
||||
Dim i As Long
|
||||
For i = 1 To cat.materials.Count
|
||||
Set mat = cat.materials(i)
|
||||
Debug.Print " - " & mat.code & ": " & mat.Name
|
||||
Next i
|
||||
|
||||
' 列出所有子类别
|
||||
Dim subCat As clsCategory
|
||||
Dim j As Long
|
||||
For j = 1 To cat.SubCategories.Count
|
||||
Set subCat = cat.SubCategories(j)
|
||||
Debug.Print " 子类别: " & subCat.categoryName & _
|
||||
" (物料数:" & subCat.materials.Count & ")"
|
||||
Next j
|
||||
End If
|
||||
End Sub
|
||||
@@ -1,986 +0,0 @@
|
||||
' ========================================
|
||||
' 模块: modModelParserExamples
|
||||
' 用途: 型号解析与物料匹配的实际应用示例
|
||||
' ========================================
|
||||
Option Explicit
|
||||
|
||||
' ========================================
|
||||
' 示例1: 根据型号生成完整的领料清单
|
||||
' ⭐ v2.0 更新：使用新的 LoadData(wsPlatform) 接口
|
||||
' ========================================
|
||||
Sub Example1_GeneratePickingListByModel()
|
||||
Dim bomMgr As New clsBOMManager
|
||||
Dim wsPlatform As Worksheet
|
||||
|
||||
' 加载配置
|
||||
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
|
||||
bomMgr.LoadData wsPlatform
|
||||
|
||||
' 产品型号
|
||||
Dim modelStr As String
|
||||
modelStr = "YTHN-100.A0.532.M203.M16.Y3|BP-095.2312.M16.PA3"
|
||||
|
||||
' 创建领料清单工作表
|
||||
Dim wsPickList As Worksheet
|
||||
On Error Resume Next
|
||||
Application.DisplayAlerts = False
|
||||
ThisWorkbook.Worksheets("型号领料清单").Delete
|
||||
Application.DisplayAlerts = True
|
||||
On Error GoTo 0
|
||||
|
||||
Set wsPickList = ThisWorkbook.Worksheets.Add
|
||||
wsPickList.Name = "型号领料清单"
|
||||
|
||||
' 写入表头
|
||||
Dim row As Long
|
||||
row = 1
|
||||
wsPickList.Cells(row, 1).value = "产品型号"
|
||||
wsPickList.Cells(row, 2).value = modelStr
|
||||
row = row + 1
|
||||
|
||||
' 提取条件并显示
|
||||
Dim conditions As Object
|
||||
Set conditions = bomMgr.ParseModelAndExtractConditions(modelStr)
|
||||
wsPickList.Cells(row, 1).value = "提取条件"
|
||||
Dim condStr As String
|
||||
Dim key As Variant
|
||||
For Each key In conditions.Keys
|
||||
condStr = condStr & key & "=" & conditions(key) & "; "
|
||||
Next key
|
||||
wsPickList.Cells(row, 2).value = condStr
|
||||
row = row + 2
|
||||
|
||||
' 表头
|
||||
wsPickList.Cells(row, 1).value = "类别"
|
||||
wsPickList.Cells(row, 2).value = "代号"
|
||||
wsPickList.Cells(row, 3).value = "名称"
|
||||
wsPickList.Cells(row, 4).value = "数量"
|
||||
wsPickList.Cells(row, 5).value = "选择条件"
|
||||
wsPickList.Cells(row, 6).value = "匹配状态"
|
||||
wsPickList.Range("A" & row & ":F" & row).Font.Bold = True
|
||||
row = row + 1
|
||||
|
||||
' 遍历所有根类别
|
||||
Dim rootCats As collection
|
||||
Set rootCats = bomMgr.GetRootCategories
|
||||
|
||||
Dim cat As clsCategory
|
||||
Dim materials As collection
|
||||
Dim mat As clsMaterialItem
|
||||
Dim i As Long
|
||||
|
||||
For i = 1 To rootCats.Count
|
||||
Set cat = rootCats(i)
|
||||
|
||||
' 获取该类别符合条件的物料
|
||||
Set materials = bomMgr.GetMaterialsByModel(modelStr, cat.categoryName)
|
||||
|
||||
' 写入物料
|
||||
Dim j As Long
|
||||
For j = 1 To materials.Count
|
||||
Set mat = materials(j)
|
||||
' 使用物料自己的Category属性，而不是外层循环的类别名称
|
||||
' 这样当GetMaterialsByModel降级到子类别查找时，能正确显示子类别名称
|
||||
wsPickList.Cells(row, 1).value = mat.Category
|
||||
wsPickList.Cells(row, 2).value = mat.code
|
||||
wsPickList.Cells(row, 3).value = mat.Name
|
||||
wsPickList.Cells(row, 4).value = mat.Quantity
|
||||
wsPickList.Cells(row, 5).value = IIf(mat.Condition = "", "(无条件)", mat.Condition)
|
||||
wsPickList.Cells(row, 6).value = "??"
|
||||
row = row + 1
|
||||
Next j
|
||||
Next i
|
||||
|
||||
' 格式化
|
||||
wsPickList.Columns("A:F").AutoFit
|
||||
|
||||
MsgBox "领料清单生成完成！" & vbCrLf & _
|
||||
"请查看工作表: 型号领料清单", vbInformation
|
||||
End Sub
|
||||
|
||||
' ========================================
|
||||
' 示例2: 批量处理多个型号
|
||||
' ⭐ v2.0 更新：使用新的 LoadData(wsPlatform) 接口
|
||||
' ========================================
|
||||
Sub Example2_BatchProcessModels()
|
||||
Dim bomMgr As New clsBOMManager
|
||||
Dim wsPlatform As Worksheet
|
||||
|
||||
' 加载配置
|
||||
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
|
||||
bomMgr.LoadData wsPlatform
|
||||
|
||||
' 型号列表
|
||||
Dim models() As String
|
||||
models = Split("YTHN-100.A0.532.M203.M16.Y3|BP-095.2312.M16.PA3," & _
|
||||
"YTHN-100.A0.532.M203.M02.Y3|BP-095.2312.M02.PA3," & _
|
||||
"YTHN-100.A0.532.M203.M12.Y3|BP-095.2312.M12.PA3", ",")
|
||||
|
||||
' 创建汇总表
|
||||
Dim wsReport As Worksheet
|
||||
On Error Resume Next
|
||||
Application.DisplayAlerts = False
|
||||
ThisWorkbook.Worksheets("批量型号汇总").Delete
|
||||
Application.DisplayAlerts = True
|
||||
On Error GoTo 0
|
||||
|
||||
Set wsReport = ThisWorkbook.Worksheets.Add
|
||||
wsReport.Name = "批量型号汇总"
|
||||
|
||||
' 表头
|
||||
Dim row As Long
|
||||
row = 1
|
||||
wsReport.Cells(row, 1).value = "型号"
|
||||
wsReport.Cells(row, 2).value = "提取条件"
|
||||
wsReport.Cells(row, 3).value = "匹配物料数"
|
||||
wsReport.Cells(row, 4).value = "部件物料"
|
||||
wsReport.Range("A1:D1").Font.Bold = True
|
||||
row = row + 1
|
||||
|
||||
' 处理每个型号
|
||||
Dim modelStr As String
|
||||
Dim i As Long
|
||||
|
||||
For i = LBound(models) To UBound(models)
|
||||
modelStr = Trim(models(i))
|
||||
If modelStr <> "" Then
|
||||
' 提取条件
|
||||
Dim conditions As Object
|
||||
Set conditions = bomMgr.ParseModelAndExtractConditions(modelStr)
|
||||
|
||||
Dim condStr As String
|
||||
condStr = ""
|
||||
Dim key As Variant
|
||||
For Each key In conditions.Keys
|
||||
condStr = condStr & key & "=" & conditions(key) & "; "
|
||||
Next key
|
||||
|
||||
' 获取物料
|
||||
Dim materials As collection
|
||||
Set materials = bomMgr.GetMaterialsByModel(modelStr, "部件")
|
||||
|
||||
' 写入结果
|
||||
wsReport.Cells(row, 1).value = modelStr
|
||||
wsReport.Cells(row, 2).value = condStr
|
||||
wsReport.Cells(row, 3).value = materials.Count
|
||||
|
||||
' 列出部件物料
|
||||
Dim matList As String
|
||||
matList = ""
|
||||
Dim mat As clsMaterialItem
|
||||
For Each mat In materials
|
||||
matList = matList & mat.code & "(" & mat.Name & "); "
|
||||
Next mat
|
||||
wsReport.Cells(row, 4).value = matList
|
||||
|
||||
row = row + 1
|
||||
End If
|
||||
Next i
|
||||
|
||||
' 格式化
|
||||
wsReport.Columns("A:D").AutoFit
|
||||
|
||||
MsgBox "批量处理完成！", vbInformation
|
||||
End Sub
|
||||
|
||||
' ========================================
|
||||
' 示例3: 查询并显示某个型号的详细信息
|
||||
' ========================================
|
||||
Sub Example3_ShowModelDetails()
|
||||
' 弹出输入框
|
||||
Dim modelStr As String
|
||||
modelStr = InputBox("请输入产品型号:", "型号查询", _
|
||||
"YTHN-100.A0.532.M203.M16.Y3")
|
||||
|
||||
If modelStr = "" Then Exit Sub
|
||||
|
||||
' 解析型号
|
||||
Dim parser As New clsModelParser
|
||||
If Not parser.ParseModel(modelStr) Then
|
||||
MsgBox "型号解析失败: " & parser.ErrorMessage, vbCritical
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' 提取条件
|
||||
Dim extractor As New clsConditionExtractor
|
||||
Dim conditions As Object
|
||||
Set conditions = extractor.ExtractConditions(parser)
|
||||
|
||||
' 显示详细信息
|
||||
Dim msg As String
|
||||
msg = "【型号解析结果】" & vbCrLf & vbCrLf
|
||||
msg = msg & "原始型号: " & parser.RawModel & vbCrLf
|
||||
msg = msg & "表头型号: " & parser.HeaderModel & vbCrLf
|
||||
msg = msg & "表盘型号: " & parser.DialModel & vbCrLf & vbCrLf
|
||||
|
||||
msg = msg & "【表头各部分】" & vbCrLf
|
||||
msg = msg & "型号: " & parser.ModelType & vbCrLf
|
||||
msg = msg & "公称外径: " & parser.Diameter & vbCrLf
|
||||
msg = msg & "安装形式: " & parser.InstallForm & vbCrLf
|
||||
msg = msg & "壳体形式: " & parser.ShellForm & vbCrLf
|
||||
msg = msg & "过程连接&材质: " & parser.ConnectionCode & vbCrLf
|
||||
msg = msg & "量程范围: " & parser.RangeCode & vbCrLf
|
||||
msg = msg & "仪表特性: " & parser.Characteristics & vbCrLf & vbCrLf
|
||||
|
||||
msg = msg & "【提取的物料选择条件】" & vbCrLf
|
||||
Dim key As Variant
|
||||
For Each key In conditions.Keys
|
||||
msg = msg & key & " = " & conditions(key) & vbCrLf
|
||||
Next key
|
||||
|
||||
MsgBox msg, vbInformation, "型号详细信息"
|
||||
End Sub
|
||||
|
||||
' ========================================
|
||||
' 示例4: 对比两个型号的差异
|
||||
' ========================================
|
||||
Sub Example4_CompareModels()
|
||||
Dim model1 As String, model2 As String
|
||||
|
||||
model1 = InputBox("请输入第一个型号:", "型号对比", _
|
||||
"YTHN-100.A0.532.M203.M16.Y3")
|
||||
If model1 = "" Then Exit Sub
|
||||
|
||||
model2 = InputBox("请输入第二个型号:", "型号对比", _
|
||||
"YTHN-100.A0.532.M203.M02.Y3")
|
||||
If model2 = "" Then Exit Sub
|
||||
|
||||
' 解析两个型号
|
||||
Dim parser1 As New clsModelParser
|
||||
Dim parser2 As New clsModelParser
|
||||
Dim extractor As New clsConditionExtractor
|
||||
|
||||
parser1.ParseModel model1
|
||||
parser2.ParseModel model2
|
||||
|
||||
Dim cond1 As Object, cond2 As Object
|
||||
Set cond1 = extractor.ExtractConditions(parser1)
|
||||
|
||||
Set extractor = New clsConditionExtractor
|
||||
Set cond2 = extractor.ExtractConditions(parser2)
|
||||
|
||||
' 对比
|
||||
Dim msg As String
|
||||
msg = "【型号对比】" & vbCrLf & vbCrLf
|
||||
msg = msg & "型号1: " & model1 & vbCrLf
|
||||
msg = msg & "型号2: " & model2 & vbCrLf & vbCrLf
|
||||
|
||||
msg = msg & "【条件差异】" & vbCrLf
|
||||
Dim key As Variant
|
||||
Dim allKeys As Object
|
||||
Set allKeys = CreateObject("Scripting.Dictionary")
|
||||
|
||||
For Each key In cond1.Keys
|
||||
allKeys(key) = True
|
||||
Next key
|
||||
For Each key In cond2.Keys
|
||||
allKeys(key) = True
|
||||
Next key
|
||||
|
||||
For Each key In allKeys.Keys
|
||||
Dim val1 As String, val2 As String
|
||||
val1 = ""
|
||||
val2 = ""
|
||||
|
||||
If cond1.Exists(key) Then val1 = cond1(key)
|
||||
If cond2.Exists(key) Then val2 = cond2(key)
|
||||
|
||||
If val1 <> val2 Then
|
||||
msg = msg & key & ": " & val1 & " → " & val2 & " ?" & vbCrLf
|
||||
Else
|
||||
msg = msg & key & ": " & val1 & " ?" & vbCrLf
|
||||
End If
|
||||
Next key
|
||||
|
||||
MsgBox msg, vbInformation, "型号对比结果"
|
||||
End Sub
|
||||
|
||||
' ========================================
|
||||
' 示例5: 验证物料选择条件的有效性
|
||||
' ⭐ v2.0 更新：使用新的 LoadData(wsPlatform) 接口
|
||||
' ========================================
|
||||
Sub Example5_ValidateMaterialConditions()
|
||||
Dim bomMgr As New clsBOMManager
|
||||
Dim wsPlatform As Worksheet
|
||||
|
||||
' 加载配置
|
||||
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
|
||||
bomMgr.LoadData wsPlatform
|
||||
|
||||
' 创建验证结果表
|
||||
Dim wsValidation As Worksheet
|
||||
On Error Resume Next
|
||||
Application.DisplayAlerts = False
|
||||
ThisWorkbook.Worksheets("条件验证结果").Delete
|
||||
Application.DisplayAlerts = True
|
||||
On Error GoTo 0
|
||||
|
||||
Set wsValidation = ThisWorkbook.Worksheets.Add
|
||||
wsValidation.Name = "条件验证结果"
|
||||
|
||||
' 表头
|
||||
Dim row As Long
|
||||
row = 1
|
||||
wsValidation.Cells(row, 1).value = "代号"
|
||||
wsValidation.Cells(row, 2).value = "名称"
|
||||
wsValidation.Cells(row, 3).value = "选择条件"
|
||||
wsValidation.Cells(row, 4).value = "验证结果"
|
||||
wsValidation.Range("A1:D1").Font.Bold = True
|
||||
row = row + 1
|
||||
|
||||
' 获取所有根类别
|
||||
Dim rootCats As collection
|
||||
Set rootCats = bomMgr.GetRootCategories
|
||||
|
||||
Dim cat As clsCategory
|
||||
Dim materials As collection
|
||||
Dim mat As clsMaterialItem
|
||||
Dim matcher As New clsConditionMatcher
|
||||
Dim i As Long
|
||||
|
||||
' 遍历所有物料
|
||||
For i = 1 To rootCats.Count
|
||||
Set cat = rootCats(i)
|
||||
Set materials = New collection
|
||||
|
||||
' 收集该类别的所有物料
|
||||
Dim j As Long
|
||||
For j = 1 To cat.materials.Count
|
||||
materials.Add cat.materials(j)
|
||||
Next j
|
||||
|
||||
' 验证每个物料的条件
|
||||
For Each mat In materials
|
||||
wsValidation.Cells(row, 1).value = mat.code
|
||||
wsValidation.Cells(row, 2).value = mat.Name
|
||||
wsValidation.Cells(row, 3).value = IIf(mat.Condition = "", "(无)", mat.Condition)
|
||||
|
||||
If mat.Condition = "" Then
|
||||
wsValidation.Cells(row, 4).value = "? 无条件"
|
||||
Else
|
||||
Dim validResult As String
|
||||
validResult = matcher.TestExpression(mat.Condition)
|
||||
wsValidation.Cells(row, 4).value = validResult
|
||||
End If
|
||||
|
||||
row = row + 1
|
||||
Next mat
|
||||
Next i
|
||||
|
||||
' 格式化
|
||||
wsValidation.Columns("A:D").AutoFit
|
||||
|
||||
MsgBox "条件验证完成！", vbInformation
|
||||
End Sub
|
||||
|
||||
' ========================================
|
||||
' 示例6: 对比启用/禁用自动降级的效果
|
||||
' ⭐ v2.0 更新：使用新的 LoadData(wsPlatform) 接口
|
||||
' ========================================
|
||||
Sub Example6_CompareAutoFallback()
|
||||
Dim bomMgr As New clsBOMManager
|
||||
Dim wsPlatform As Worksheet
|
||||
|
||||
' 加载配置
|
||||
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
|
||||
bomMgr.LoadData 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
|
||||
|
||||
' ========================================
|
||||
' 示例7: 测试GetValidMaterialsByModel方法 (使用内置的缺失列表)
|
||||
' ⭐ v2.0 更新：使用新的 LoadData(wsPlatform) 接口
|
||||
' 完整性检查使用"类别选用条件"动态判断需要的类别
|
||||
' ========================================
|
||||
Sub Example7_TestGetValidMaterialsByModel()
|
||||
Dim bomMgr As New clsBOMManager
|
||||
Dim wsPlatform As Worksheet
|
||||
|
||||
' 加载配置
|
||||
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
|
||||
bomMgr.LoadData wsPlatform
|
||||
|
||||
' 创建测试结果工作表
|
||||
Dim wsTest As Worksheet
|
||||
On Error Resume Next
|
||||
Application.DisplayAlerts = False
|
||||
ThisWorkbook.Worksheets("物料完整性测试").Delete
|
||||
Application.DisplayAlerts = True
|
||||
On Error GoTo 0
|
||||
|
||||
Set wsTest = ThisWorkbook.Worksheets.Add
|
||||
wsTest.Name = "物料完整性测试"
|
||||
|
||||
' 写入标题
|
||||
Dim row As Long
|
||||
row = 1
|
||||
wsTest.Cells(row, 1).value = "物料完整性测试报告"
|
||||
wsTest.Cells(row, 1).Font.Bold = True
|
||||
wsTest.Cells(row, 1).Font.Size = 14
|
||||
row = row + 2
|
||||
|
||||
' 定义测试型号
|
||||
Dim testModels() As Variant
|
||||
testModels = Array( _
|
||||
Array("YTHN-100.A0.532.M203.M16.Y3|BP-095.2312.M16.PA3", "完整型号测试1"), _
|
||||
Array("YTHN-100.A0.532.M203.M17.Y3", "缺失子类别测试") _
|
||||
)
|
||||
|
||||
Dim i As Long
|
||||
For i = LBound(testModels) To UBound(testModels)
|
||||
Dim modelStr As String
|
||||
Dim testName As String
|
||||
modelStr = testModels(i)(0)
|
||||
testName = testModels(i)(1)
|
||||
|
||||
' 1. 调用方法获取结果
|
||||
Dim result As collection
|
||||
Set result = bomMgr.GetValidMaterialsByModel(modelStr)
|
||||
|
||||
Dim materials As collection
|
||||
Dim missingCats As collection
|
||||
Dim isComplete As Boolean
|
||||
|
||||
Set materials = result("Materials")
|
||||
Set missingCats = result("MissingCategories") ' 直接获取缺失列表
|
||||
isComplete = result("IsComplete")
|
||||
|
||||
' 2. 写入头部信息
|
||||
wsTest.Cells(row, 1).value = "测试 " & (i + 1) & ": " & testName
|
||||
wsTest.Cells(row, 1).Font.Bold = True
|
||||
wsTest.Cells(row, 1).Interior.Color = RGB(240, 240, 240)
|
||||
row = row + 1
|
||||
|
||||
wsTest.Cells(row, 1).value = "型号:"
|
||||
wsTest.Cells(row, 2).value = modelStr
|
||||
row = row + 1
|
||||
|
||||
wsTest.Cells(row, 1).value = "完整性:"
|
||||
wsTest.Cells(row, 2).value = IIf(isComplete, "?? 完整", "?? 不完整")
|
||||
If isComplete Then
|
||||
wsTest.Cells(row, 2).Font.Color = RGB(0, 128, 0)
|
||||
Else
|
||||
wsTest.Cells(row, 2).Font.Color = RGB(255, 0, 0)
|
||||
End If
|
||||
wsTest.Cells(row, 2).Font.Bold = True
|
||||
row = row + 1
|
||||
|
||||
' 3. 打印匹配到的物料
|
||||
wsTest.Cells(row, 1).value = "【已匹配物料】"
|
||||
wsTest.Cells(row, 1).Font.Bold = True
|
||||
row = row + 1
|
||||
|
||||
wsTest.Cells(row, 1).value = "类别"
|
||||
wsTest.Cells(row, 2).value = "代号"
|
||||
wsTest.Cells(row, 3).value = "名称"
|
||||
wsTest.Cells(row, 4).value = "数量"
|
||||
wsTest.Range(wsTest.Cells(row, 1), wsTest.Cells(row, 4)).Font.Bold = True
|
||||
wsTest.Range(wsTest.Cells(row, 1), wsTest.Cells(row, 4)).Interior.Color = RGB(220, 220, 220)
|
||||
row = row + 1
|
||||
|
||||
Dim mat As clsMaterialItem
|
||||
If materials.Count > 0 Then
|
||||
For Each mat In materials
|
||||
wsTest.Cells(row, 1).value = mat.Category
|
||||
wsTest.Cells(row, 2).value = mat.code
|
||||
wsTest.Cells(row, 3).value = mat.Name
|
||||
wsTest.Cells(row, 4).value = mat.Quantity
|
||||
row = row + 1
|
||||
Next mat
|
||||
Else
|
||||
wsTest.Cells(row, 1).value = "(无)"
|
||||
row = row + 1
|
||||
End If
|
||||
|
||||
' 4. 打印缺失的类别 (新增核心功能)
|
||||
If missingCats.Count > 0 Then
|
||||
row = row + 1
|
||||
wsTest.Cells(row, 1).value = "【缺失类别】"
|
||||
wsTest.Cells(row, 1).Font.Color = RGB(255, 0, 0)
|
||||
wsTest.Cells(row, 1).Font.Bold = True
|
||||
row = row + 1
|
||||
|
||||
Dim catName As Variant
|
||||
For Each catName In missingCats
|
||||
wsTest.Cells(row, 1).value = "?? " & catName
|
||||
wsTest.Cells(row, 1).Font.Color = RGB(255, 0, 0)
|
||||
wsTest.Cells(row, 2).value = "未找到匹配物料"
|
||||
row = row + 1
|
||||
Next catName
|
||||
End If
|
||||
|
||||
' 添加分隔行
|
||||
row = row + 1
|
||||
wsTest.Cells(row, 1).value = String(80, "-")
|
||||
row = row + 2
|
||||
Next i
|
||||
|
||||
wsTest.Columns("A:D").AutoFit
|
||||
MsgBox "测试完成！", vbInformation
|
||||
End Sub
|
||||
|
||||
' ========================================
|
||||
' 示例8: 批量处理产品订单，生成物料清单
|
||||
' ⭐ v2.0 更新：使用新的 LoadData(wsPlatform) 接口
|
||||
' ========================================
|
||||
Sub Example8_BatchProcessOrders()
|
||||
Dim bomMgr As New clsBOMManager
|
||||
Dim wsPlatform As Worksheet
|
||||
Dim wsOrders As Worksheet
|
||||
Dim wsOutput As Worksheet
|
||||
|
||||
' 加载配置
|
||||
On Error Resume Next
|
||||
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
|
||||
Set wsOrders = ThisWorkbook.Worksheets("产品订单")
|
||||
|
||||
If wsPlatform Is Nothing Then
|
||||
MsgBox "找不到工作表: 平台配置清单", vbCritical
|
||||
Exit Sub
|
||||
End If
|
||||
If wsOrders Is Nothing Then
|
||||
MsgBox "找不到工作表: 产品订单", vbCritical
|
||||
Exit Sub
|
||||
End If
|
||||
On Error GoTo 0
|
||||
|
||||
bomMgr.LoadData wsPlatform
|
||||
|
||||
' 读取订单数据
|
||||
Dim lastRow As Long
|
||||
lastRow = wsOrders.Cells(wsOrders.Rows.Count, "A").End(xlUp).row
|
||||
|
||||
If lastRow < 2 Then
|
||||
MsgBox "产品订单工作表没有数据！" & vbCrLf & _
|
||||
"请确保第一行是表头，从第二行开始是数据。", vbExclamation
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' 使用 Collection 收集所有输出行
|
||||
Dim outputData As collection
|
||||
Set outputData = New collection
|
||||
|
||||
' 添加表头
|
||||
outputData.Add Array("来源单号", "产品型号", "物料代码", "物料名称", "数量", "选择条件", "类别")
|
||||
|
||||
' 遍历每个订单，收集数据
|
||||
Dim i As Long
|
||||
Dim orderNo As String
|
||||
Dim modelStr As String
|
||||
Dim materials As collection
|
||||
Dim mat As clsMaterialItem
|
||||
Dim processedCount As Long
|
||||
Dim materialCount As Long
|
||||
|
||||
processedCount = 0
|
||||
materialCount = 0
|
||||
|
||||
For i = 2 To lastRow
|
||||
orderNo = Trim(wsOrders.Cells(i, 1).value)
|
||||
modelStr = Trim(wsOrders.Cells(i, 2).value)
|
||||
|
||||
' 跳过空行
|
||||
If orderNo = "" And modelStr = "" Then
|
||||
GoTo ContinueLoop
|
||||
End If
|
||||
|
||||
' 验证必填字段
|
||||
If orderNo = "" Then
|
||||
orderNo = "(未填写)"
|
||||
End If
|
||||
|
||||
If modelStr = "" Then
|
||||
outputData.Add Array(orderNo, "(空白型号)", "错误", "产品型号为空", "", "", "")
|
||||
GoTo ContinueLoop
|
||||
End If
|
||||
|
||||
' 获取物料
|
||||
On Error Resume Next
|
||||
Set materials = bomMgr.GetMaterialsByModel(modelStr, "", True)
|
||||
On Error GoTo 0
|
||||
|
||||
If materials Is Nothing Then
|
||||
outputData.Add Array(orderNo, modelStr, "错误", "无法解析型号或获取物料", "", "", "")
|
||||
GoTo ContinueLoop
|
||||
End If
|
||||
|
||||
' 收集物料明细
|
||||
If materials.Count > 0 Then
|
||||
For Each mat In materials
|
||||
outputData.Add Array( _
|
||||
orderNo, _
|
||||
modelStr, _
|
||||
mat.code, _
|
||||
mat.Name, _
|
||||
mat.Quantity, _
|
||||
IIf(mat.Condition = "", "(无条件)", mat.Condition), _
|
||||
mat.Category _
|
||||
)
|
||||
materialCount = materialCount + 1
|
||||
Next mat
|
||||
Else
|
||||
outputData.Add Array(orderNo, modelStr, "(无)", "未找到任何匹配物料", "", "", "")
|
||||
End If
|
||||
|
||||
processedCount = processedCount + 1
|
||||
|
||||
ContinueLoop:
|
||||
Next i
|
||||
|
||||
' 创建输出工作表
|
||||
On Error Resume Next
|
||||
Application.DisplayAlerts = False
|
||||
ThisWorkbook.Worksheets("产品订单物料清单").Delete
|
||||
Application.DisplayAlerts = True
|
||||
On Error GoTo 0
|
||||
|
||||
Set wsOutput = ThisWorkbook.Worksheets.Add
|
||||
wsOutput.Name = "产品订单物料清单"
|
||||
|
||||
' 批量写入数据到工作表
|
||||
If outputData.Count > 0 Then
|
||||
Dim dataArray() As Variant
|
||||
ReDim dataArray(1 To outputData.Count, 1 To 7)
|
||||
|
||||
Dim j As Long
|
||||
Dim rowArr As Variant
|
||||
For j = 1 To outputData.Count
|
||||
rowArr = outputData(j)
|
||||
dataArray(j, 1) = rowArr(0)
|
||||
dataArray(j, 2) = rowArr(1)
|
||||
dataArray(j, 3) = rowArr(2) ' 这里是物料代码
|
||||
dataArray(j, 4) = rowArr(3)
|
||||
dataArray(j, 5) = rowArr(4)
|
||||
dataArray(j, 6) = rowArr(5)
|
||||
dataArray(j, 7) = rowArr(6)
|
||||
Next j
|
||||
|
||||
' --- 关键修改：在写入数据前，将 C 列设置为文本格式 ---
|
||||
' 使用 NumberFormat = "@" 强制指定为文本格式
|
||||
wsOutput.Columns("C").NumberFormat = "@"
|
||||
|
||||
' 一次性写入
|
||||
wsOutput.Range("A1").Resize(outputData.Count, 7).value = dataArray
|
||||
|
||||
' 格式化表头
|
||||
With wsOutput.Range("A1:G1")
|
||||
.Font.Bold = True
|
||||
.Interior.Color = RGB(200, 200, 200)
|
||||
' 表头所在的 C1 单元格通常可以改回常规格式，或者保持文本格式也不影响
|
||||
.NumberFormat = "General"
|
||||
End With
|
||||
End If
|
||||
|
||||
' 格式化
|
||||
wsOutput.Columns("A:G").AutoFit
|
||||
|
||||
' 显示统计信息
|
||||
Dim msg As String
|
||||
msg = "批量处理完成！" & vbCrLf & vbCrLf
|
||||
msg = msg & "处理订单数: " & processedCount & vbCrLf
|
||||
msg = msg & "生成物料记录: " & materialCount & " 条" & vbCrLf & vbCrLf
|
||||
msg = msg & "请查看工作表: 产品订单物料清单"
|
||||
|
||||
MsgBox msg, vbInformation
|
||||
End Sub
|
||||
|
||||
' ========================================
|
||||
' 示例9: 批量处理订单 - 带完整性检查与模块数量校验
|
||||
' 功能：
|
||||
' 1. 提取型号条件
|
||||
' 2. 校验模块数量（如果是3个模块则报错）
|
||||
' 3. 校验类别完整性（如果缺失类别则报错，使用类别选用条件判断）
|
||||
' 4. 生成BOM清单
|
||||
'
|
||||
' ⭐ v2.0 更新：
|
||||
' - 移除 [领料配置] 表依赖
|
||||
' - 使用新的 LoadData(wsPlatform) 接口（单参数）
|
||||
' - 完整性检查使用"类别选用条件"动态判断需要的类别
|
||||
' ========================================
|
||||
Sub Example9_BatchProcessOrders_WithCheck()
|
||||
Dim bomMgr As New clsBOMManager
|
||||
Dim wsPlatform As Worksheet, wsOrders As Worksheet, wsOutput As Worksheet
|
||||
Dim parser As clsModelParser
|
||||
Dim extractor As clsConditionExtractor
|
||||
|
||||
' 1. 初始化与加载数据
|
||||
On Error Resume Next
|
||||
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
|
||||
Set wsOrders = ThisWorkbook.Worksheets("产品订单")
|
||||
On Error GoTo 0
|
||||
|
||||
If wsPlatform Is Nothing Or wsOrders Is Nothing Then
|
||||
MsgBox "错误：缺少必要的工作表 (平台配置清单/产品订单)", vbCritical
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' ⭐ 使用新接口：只需要一个参数
|
||||
bomMgr.LoadData wsPlatform
|
||||
|
||||
' 2. 准备输出容器
|
||||
Dim outputData As collection
|
||||
Set outputData = New collection
|
||||
' 添加表头
|
||||
outputData.Add Array("来源单号", "产品型号", "物料代码", "物料名称", "数量", "选择条件", "提取的物料选择条件", "类别", "备注")
|
||||
|
||||
' 3. 遍历订单
|
||||
Dim lastRow As Long
|
||||
lastRow = wsOrders.Cells(wsOrders.Rows.Count, "A").End(xlUp).row
|
||||
|
||||
Dim i As Long
|
||||
Dim orderNo As String, modelStr As String
|
||||
Dim extractedCondStr As String
|
||||
Dim parts() As String
|
||||
Dim moduleCount As Integer
|
||||
Dim result As collection, materials As collection, missingCats As collection
|
||||
Dim isComplete As Boolean
|
||||
Dim mat As clsMaterialItem
|
||||
|
||||
' 辅助变量
|
||||
Dim key As Variant
|
||||
Dim missingStr As String
|
||||
Dim catItem As Variant
|
||||
|
||||
For i = 2 To lastRow
|
||||
orderNo = Trim(wsOrders.Cells(i, 1).value)
|
||||
modelStr = Trim(wsOrders.Cells(i, 2).value)
|
||||
|
||||
If orderNo = "" And modelStr = "" Then GoTo NextOrder
|
||||
If orderNo = "" Then orderNo = "(未填写)"
|
||||
|
||||
' -------------------------------------------------
|
||||
' 步骤 A: 解析型号并提取条件字符串 (用于输出列)
|
||||
' -------------------------------------------------
|
||||
extractedCondStr = ""
|
||||
Set parser = New clsModelParser
|
||||
Set extractor = New clsConditionExtractor
|
||||
|
||||
If parser.ParseModel(modelStr) Then
|
||||
Dim conditions As Object
|
||||
Set conditions = extractor.ExtractConditions(parser)
|
||||
For Each key In conditions.Keys
|
||||
extractedCondStr = extractedCondStr & key & "=" & conditions(key) & "; "
|
||||
Next key
|
||||
If Len(extractedCondStr) > 2 Then extractedCondStr = Left(extractedCondStr, Len(extractedCondStr) - 2)
|
||||
Else
|
||||
' 解析失败直接输出错误
|
||||
outputData.Add Array(orderNo, modelStr, "", "", "", "", "", "", "解析失败: " & parser.ErrorMessage)
|
||||
GoTo NextOrder
|
||||
End If
|
||||
|
||||
' -------------------------------------------------
|
||||
' 步骤 B: 校验模块数量 (表头 | 表盘 | 附件 | 法兰)
|
||||
' -------------------------------------------------
|
||||
' Split返回0-based数组。0=1个模块, 1=2个模块, 2=3个模块
|
||||
parts = Split(modelStr, "|")
|
||||
moduleCount = UBound(parts) + 1
|
||||
|
||||
' 规则：如果出现三个模块，不输出物料，备注填入原因
|
||||
If moduleCount = 3 Then
|
||||
outputData.Add Array(orderNo, modelStr, "", "", "", "", extractedCondStr, "", "包含其它模块")
|
||||
GoTo NextOrder
|
||||
End If
|
||||
|
||||
' -------------------------------------------------
|
||||
' 步骤 C: 获取物料并校验类别完整性
|
||||
' -------------------------------------------------
|
||||
Set result = bomMgr.GetValidMaterialsByModel(modelStr)
|
||||
|
||||
isComplete = result("IsComplete")
|
||||
Set materials = result("Materials")
|
||||
Set missingCats = result("MissingCategories")
|
||||
|
||||
' 规则：如果类别缺失，不输出物料，备注填入缺失的类别
|
||||
If Not isComplete Then
|
||||
missingStr = ""
|
||||
For Each catItem In missingCats
|
||||
missingStr = missingStr & catItem & ", "
|
||||
Next catItem
|
||||
|
||||
If Len(missingStr) > 2 Then missingStr = Left(missingStr, Len(missingStr) - 2)
|
||||
If missingStr = "" Then missingStr = "完整性校验未通过(未知原因)" ' 防御性编程
|
||||
|
||||
outputData.Add Array(orderNo, modelStr, "", "", "", "", extractedCondStr, "", "类别缺失: " & missingStr)
|
||||
GoTo NextOrder
|
||||
End If
|
||||
|
||||
' -------------------------------------------------
|
||||
' 步骤 D: 正常输出物料
|
||||
' -------------------------------------------------
|
||||
If materials.Count > 0 Then
|
||||
For Each mat In materials
|
||||
outputData.Add Array( _
|
||||
orderNo, _
|
||||
modelStr, _
|
||||
mat.code, _
|
||||
mat.Name, _
|
||||
mat.Quantity, _
|
||||
IIf(mat.Condition = "", "(无条件)", mat.Condition), _
|
||||
extractedCondStr, _
|
||||
mat.Category, _
|
||||
"" _
|
||||
)
|
||||
Next mat
|
||||
Else
|
||||
outputData.Add Array(orderNo, modelStr, "", "", "", "", extractedCondStr, "", "无匹配物料")
|
||||
End If
|
||||
|
||||
NextOrder:
|
||||
Next i
|
||||
|
||||
' 4. 写入结果到新工作表
|
||||
On Error Resume Next
|
||||
Application.DisplayAlerts = False
|
||||
ThisWorkbook.Worksheets("订单BOM_校验版").Delete
|
||||
Application.DisplayAlerts = True
|
||||
On Error GoTo 0
|
||||
|
||||
Set wsOutput = ThisWorkbook.Worksheets.Add
|
||||
wsOutput.Name = "订单BOM_校验版"
|
||||
|
||||
If outputData.Count > 0 Then
|
||||
' 转换为二维数组以提高写入速度
|
||||
Dim dataArr() As Variant
|
||||
ReDim dataArr(1 To outputData.Count, 1 To 9)
|
||||
|
||||
Dim r As Long, c As Long
|
||||
Dim rowItem As Variant
|
||||
|
||||
For r = 1 To outputData.Count
|
||||
rowItem = outputData(r)
|
||||
For c = 0 To 8
|
||||
dataArr(r, c + 1) = rowItem(c)
|
||||
Next c
|
||||
Next r
|
||||
|
||||
' 设置物料代码列(C列)为文本格式
|
||||
wsOutput.Columns("C:C").NumberFormat = "@"
|
||||
|
||||
' 写入数据
|
||||
wsOutput.Range("A1").Resize(outputData.Count, 9).value = dataArr
|
||||
|
||||
' 格式化美化
|
||||
With wsOutput.Range("A1:I1")
|
||||
.Font.Bold = True
|
||||
.Interior.Color = RGB(220, 230, 241)
|
||||
.HorizontalAlignment = xlCenter
|
||||
End With
|
||||
|
||||
wsOutput.Columns("A:I").AutoFit
|
||||
' 备注列标红显示
|
||||
wsOutput.Columns("I:I").Font.Color = RGB(255, 0, 0)
|
||||
wsOutput.Cells(1, 9).Font.Color = RGB(0, 0, 0) ' 表头改回黑色
|
||||
End If
|
||||
|
||||
MsgBox "处理完成！请查看工作表 '订单BOM_校验版'。", vbInformation
|
||||
End Sub
|
||||
@@ -1,307 +0,0 @@
|
||||
' ========================================
|
||||
' 模块: modModelParserTest
|
||||
' 用途: 测试型号解析和物料匹配功能
|
||||
' ========================================
|
||||
Option Explicit
|
||||
|
||||
' ========================================
|
||||
' 测试1: 型号解析器基础功能
|
||||
' ========================================
|
||||
Sub Test1_ModelParser()
|
||||
Debug.Print String(80, "=")
|
||||
Debug.Print "测试1: 型号解析器基础功能"
|
||||
Debug.Print String(80, "=")
|
||||
|
||||
Dim parser As New clsModelParser
|
||||
Dim modelStr As String
|
||||
|
||||
' 测试用例1: 完整型号
|
||||
modelStr = "YTHN-100.A0.532.M203.M16.Y3|BP-095.2312.M16.PA3"
|
||||
Debug.Print "【测试用例1】完整型号"
|
||||
Debug.Print "输入: " & modelStr
|
||||
|
||||
If parser.ParseModel(modelStr) Then
|
||||
Debug.Print parser.ToString()
|
||||
Debug.Print "? 解析成功"
|
||||
Else
|
||||
Debug.Print "? 解析失败: " & parser.ErrorMessage
|
||||
End If
|
||||
|
||||
Debug.Print ""
|
||||
|
||||
' 测试用例2: 仅表头
|
||||
modelStr = "YTHN-100.A0.532.M203.M16.Y3"
|
||||
Debug.Print "【测试用例2】仅表头"
|
||||
Debug.Print "输入: " & modelStr
|
||||
|
||||
If parser.ParseModel(modelStr) Then
|
||||
Debug.Print " 螺纹代码: " & parser.GetThreadCode()
|
||||
Debug.Print " 材质代码: " & parser.GetMaterialCode()
|
||||
Debug.Print " 量程代码: " & parser.GetRangeCode()
|
||||
Debug.Print "? 解析成功"
|
||||
Else
|
||||
Debug.Print "? 解析失败: " & parser.ErrorMessage
|
||||
End If
|
||||
|
||||
Debug.Print String(80, "=")
|
||||
Debug.Print ""
|
||||
End Sub
|
||||
|
||||
' ========================================
|
||||
' 测试2: 条件提取器
|
||||
' ========================================
|
||||
Sub Test2_ConditionExtractor()
|
||||
Debug.Print String(80, "=")
|
||||
Debug.Print "测试2: 条件提取器"
|
||||
Debug.Print String(80, "=")
|
||||
|
||||
Dim parser As New clsModelParser
|
||||
Dim extractor As New clsConditionExtractor
|
||||
Dim modelStr As String
|
||||
|
||||
modelStr = "YTHN-100.A0.532.M203.M16.Y3"
|
||||
Debug.Print "输入型号: " & modelStr
|
||||
|
||||
If parser.ParseModel(modelStr) Then
|
||||
Dim conditions As Object
|
||||
Set conditions = extractor.ExtractConditions(parser)
|
||||
|
||||
Debug.Print extractor.ToString()
|
||||
|
||||
' 验证提取结果
|
||||
Debug.Print "【验证】"
|
||||
Debug.Print " gclj = " & extractor.GetConditionValue("gclj") & _
|
||||
IIf(extractor.GetConditionValue("gclj") = "M20", " ?", " ?")
|
||||
Debug.Print " jycz = " & extractor.GetConditionValue("jycz") & _
|
||||
IIf(extractor.GetConditionValue("jycz") = "3", " ?", " ?")
|
||||
Debug.Print " lcfw = " & extractor.GetConditionValue("lcfw") & _
|
||||
IIf(extractor.GetConditionValue("lcfw") = "M16", " ?", " ?")
|
||||
Else
|
||||
Debug.Print "? 型号解析失败"
|
||||
End If
|
||||
|
||||
Debug.Print String(80, "=")
|
||||
Debug.Print ""
|
||||
End Sub
|
||||
|
||||
' ========================================
|
||||
' 测试3: 条件匹配器
|
||||
' ========================================
|
||||
Sub Test3_ConditionMatcher()
|
||||
Debug.Print String(80, "=")
|
||||
Debug.Print "测试3: 条件匹配器"
|
||||
Debug.Print String(80, "=")
|
||||
|
||||
Dim matcher As New clsConditionMatcher
|
||||
Dim conditions As Object
|
||||
Set conditions = CreateObject("Scripting.Dictionary")
|
||||
conditions("gclj") = "M20"
|
||||
conditions("jycz") = "3"
|
||||
conditions("lcfw") = "M16"
|
||||
|
||||
Debug.Print "【测试条件】"
|
||||
Debug.Print " gclj = M20"
|
||||
Debug.Print " jycz = 3"
|
||||
Debug.Print " lcfw = M16"
|
||||
Debug.Print ""
|
||||
|
||||
' 测试用例
|
||||
Dim testCases As Variant
|
||||
testCases = Array( _
|
||||
Array("", True, "空条件"), _
|
||||
Array("lcfw=M16", True, "简单等于"), _
|
||||
Array("lcfw=M17", False, "简单不匹配"), _
|
||||
Array("lcfw=M16 AND gclj=M20", True, "AND 全真"), _
|
||||
Array("lcfw=M16 AND gclj=M10", False, "AND 一假"), _
|
||||
Array("lcfw=M16 OR lcfw=M17", True, "OR 一真"), _
|
||||
Array("lcfw=M15 OR lcfw=M17", False, "OR 全假"), _
|
||||
Array("gclj!=M10", True, "不等于 真"), _
|
||||
Array("gclj!=M20", False, "不等于 假"), _
|
||||
Array("lcfw=M02 AND gclj!=M20", False, "复合条件1"), _
|
||||
Array("lcfw=M16 AND gclj!=M10", True, "复合条件2"), _
|
||||
Array("gclj=M20 AND (lcfw=M16 OR lcfw=M17)", True, "括号优先级1"), _
|
||||
Array("gclj=M20 AND (lcfw=M15 OR lcfw=M17)", False, "括号优先级2") _
|
||||
)
|
||||
|
||||
Dim i As Long
|
||||
Dim testCase As Variant
|
||||
Dim expr As String
|
||||
Dim expected As Boolean
|
||||
Dim actual As Boolean
|
||||
Dim description As String
|
||||
Dim passCount As Long
|
||||
Dim failCount As Long
|
||||
|
||||
passCount = 0
|
||||
failCount = 0
|
||||
|
||||
Debug.Print "【测试用例】"
|
||||
For i = LBound(testCases) To UBound(testCases)
|
||||
testCase = testCases(i)
|
||||
expr = testCase(0)
|
||||
expected = testCase(1)
|
||||
description = testCase(2)
|
||||
|
||||
actual = matcher.IsMatch(expr, conditions)
|
||||
|
||||
If actual = expected Then
|
||||
Debug.Print " ? " & description & ": " & IIf(expr = "", "(空)", expr)
|
||||
passCount = passCount + 1
|
||||
Else
|
||||
Debug.Print " ? " & description & ": " & expr
|
||||
Debug.Print " 预期: " & expected & ", 实际: " & actual
|
||||
failCount = failCount + 1
|
||||
End If
|
||||
Next i
|
||||
|
||||
Debug.Print ""
|
||||
Debug.Print "【统计】"
|
||||
Debug.Print " 通过: " & passCount
|
||||
Debug.Print " 失败: " & failCount
|
||||
|
||||
Debug.Print String(80, "=")
|
||||
Debug.Print ""
|
||||
End Sub
|
||||
|
||||
' ========================================
|
||||
' 测试4: 完整流程 - 根据型号获取物料
|
||||
' ========================================
|
||||
Sub Test4_GetMaterialsByModel()
|
||||
Debug.Print String(80, "=")
|
||||
Debug.Print "测试4: 根据型号获取物料（完整流程）"
|
||||
Debug.Print String(80, "=")
|
||||
|
||||
' 加载BOM数据
|
||||
Dim bomMgr As New clsBOMManager
|
||||
Dim wsPlatform As Worksheet
|
||||
|
||||
On Error Resume Next
|
||||
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
|
||||
On Error GoTo 0
|
||||
|
||||
If wsPlatform Is Nothing Then
|
||||
Debug.Print "? 错误: 找不到必需的工作表 [平台配置清单]"
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' ⭐ 使用新接口
|
||||
bomMgr.LoadData wsPlatform
|
||||
Debug.Print "? BOM数据加载完成"
|
||||
Debug.Print ""
|
||||
|
||||
' 测试型号
|
||||
Dim modelStr As String
|
||||
modelStr = "YTHN-100.A0.532.M203.M16.Y3|BP-095.2312.M16.PA3"
|
||||
|
||||
' 获取"部件"类别的符合条件的物料
|
||||
Dim materials As collection
|
||||
Set materials = bomMgr.GetMaterialsByModel(modelStr, "部件")
|
||||
|
||||
Debug.Print ""
|
||||
Debug.Print "【结果验证】"
|
||||
If materials.Count = 1 Then
|
||||
Dim mat As clsMaterialItem
|
||||
Set mat = materials(1)
|
||||
If mat.code = "01011019018" And mat.Name = "高压接头部件" Then
|
||||
Debug.Print "? 测试通过！成功匹配到正确的物料"
|
||||
Debug.Print " 代号: " & mat.code
|
||||
Debug.Print " 名称: " & mat.Name
|
||||
Debug.Print " 条件: " & mat.Condition
|
||||
Else
|
||||
Debug.Print "? 匹配到的物料不正确"
|
||||
End If
|
||||
Else
|
||||
Debug.Print "? 匹配数量不正确，预期1个，实际" & materials.Count & "个"
|
||||
End If
|
||||
|
||||
Debug.Print String(80, "=")
|
||||
Debug.Print ""
|
||||
End Sub
|
||||
|
||||
' ========================================
|
||||
' 测试5: 获取所有类别的符合条件的物料
|
||||
' ========================================
|
||||
Sub Test5_GetAllMaterialsByModel()
|
||||
Debug.Print String(80, "=")
|
||||
Debug.Print "测试5: 获取所有类别的符合条件的物料"
|
||||
Debug.Print String(80, "=")
|
||||
|
||||
' 加载BOM数据
|
||||
Dim bomMgr As New clsBOMManager
|
||||
Dim wsPlatform As Worksheet
|
||||
|
||||
On Error Resume Next
|
||||
Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单")
|
||||
On Error GoTo 0
|
||||
|
||||
If wsPlatform Is Nothing Then
|
||||
Debug.Print "? 错误: 找不到必需的工作表 [平台配置清单]"
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' ⭐ 使用新接口
|
||||
bomMgr.LoadData wsPlatform
|
||||
|
||||
' 测试型号
|
||||
Dim modelStr As String
|
||||
modelStr = "YTHN-100.A0.532.M203.M16.Y3"
|
||||
|
||||
' 获取所有类别的符合条件的物料
|
||||
Dim materials As collection
|
||||
Set materials = bomMgr.GetMaterialsByModel(modelStr)
|
||||
|
||||
Debug.Print ""
|
||||
Debug.Print "【匹配结果汇总】"
|
||||
Debug.Print " 共匹配 " & materials.Count & " 个物料"
|
||||
|
||||
Debug.Print String(80, "=")
|
||||
Debug.Print ""
|
||||
End Sub
|
||||
|
||||
' ========================================
|
||||
' 运行所有测试
|
||||
' ========================================
|
||||
Sub RunAllTests()
|
||||
Debug.Print vbCrLf & vbCrLf
|
||||
Debug.Print "╔" & String(78, "═") & "╗"
|
||||
Debug.Print "║" & Space(20) & "型号解析与物料匹配 - 完整测试套件" & Space(20) & "║"
|
||||
Debug.Print "╚" & String(78, "═") & "╝"
|
||||
Debug.Print ""
|
||||
|
||||
Test1_ModelParser
|
||||
Test2_ConditionExtractor
|
||||
Test3_ConditionMatcher
|
||||
Test4_GetMaterialsByModel
|
||||
Test5_GetAllMaterialsByModel
|
||||
|
||||
Debug.Print "╔" & String(78, "═") & "╗"
|
||||
Debug.Print "║" & Space(30) & "所有测试完成" & Space(30) & "║"
|
||||
Debug.Print "╚" & String(78, "═") & "╝"
|
||||
End Sub
|
||||
|
||||
' ========================================
|
||||
' 测试6: 条件提取规则展示
|
||||
' ========================================
|
||||
Sub Test6_ShowExtractionRules()
|
||||
Debug.Print String(80, "=")
|
||||
Debug.Print "测试6: 当前配置的条件提取规则"
|
||||
Debug.Print String(80, "=")
|
||||
|
||||
Dim extractor As New clsConditionExtractor
|
||||
Dim rules As Object
|
||||
Set rules = extractor.GetExtractionRules()
|
||||
|
||||
Debug.Print "【提取规则配置】"
|
||||
Dim key As Variant
|
||||
For Each key In rules.Keys
|
||||
Dim ruleInfo As Variant
|
||||
ruleInfo = rules(key)
|
||||
Debug.Print " 变量名: " & key
|
||||
Debug.Print " 源字段: " & ruleInfo(0)
|
||||
Debug.Print " 提取方法: " & ruleInfo(1)
|
||||
Debug.Print ""
|
||||
Next key
|
||||
|
||||
Debug.Print String(80, "=")
|
||||
Debug.Print ""
|
||||
End Sub
|
||||
Reference in New Issue
Block a user