From 2b9ba2de9c5772681704df950672e13748d8bd78 Mon Sep 17 00:00:00 2001 From: Misaka_Company Date: Thu, 29 Jan 2026 17:05:28 +0800 Subject: [PATCH] clear --- VBA/ClassModules/clsBOMManager.cls | 987 ------ VBA/ClassModules/clsCategory.cls | 84 - VBA/ClassModules/clsConditionExtractor.cls | 243 -- VBA/ClassModules/clsConditionMatcher.cls | 250 -- VBA/ClassModules/clsMaterialItem.cls | 14 - VBA/ClassModules/clsMaterialWithFlag.cls | 34 - VBA/ClassModules/clsModelParser.cls | 229 -- VBA/Modules/modBOMProcessor.bas | 178 - VBA/Modules/modModelParserExamples.bas | 986 ------ VBA/Modules/modModelParserTest.bas | 307 -- ...mple1_GeneratePickingListByModel_时序图.md | 464 --- ...sBOMManager_LoadData流程分析-v2(整合后).md | 530 --- .../clsBOMManager_LoadData流程分析.md | 439 --- reference_docs/clsBOMManager使用说明.md | 545 ---- reference_docs/combined_output.md | 2876 ----------------- .../型号解析与物料匹配系统 - 使用说明.md | 428 --- reference_docs/平台配置清单.md | 11 - reference_docs/新增条件提取计划.md | 276 -- .../重构计划-整合领料配置到平台配置清单.md | 650 ---- 19 files changed, 9531 deletions(-) delete mode 100644 VBA/ClassModules/clsBOMManager.cls delete mode 100644 VBA/ClassModules/clsCategory.cls delete mode 100644 VBA/ClassModules/clsConditionExtractor.cls delete mode 100644 VBA/ClassModules/clsConditionMatcher.cls delete mode 100644 VBA/ClassModules/clsMaterialItem.cls delete mode 100644 VBA/ClassModules/clsMaterialWithFlag.cls delete mode 100644 VBA/ClassModules/clsModelParser.cls delete mode 100644 VBA/Modules/modBOMProcessor.bas delete mode 100644 VBA/Modules/modModelParserExamples.bas delete mode 100644 VBA/Modules/modModelParserTest.bas delete mode 100644 reference_docs/Example1_GeneratePickingListByModel_时序图.md delete mode 100644 reference_docs/clsBOMManager_LoadData流程分析-v2(整合后).md delete mode 100644 reference_docs/clsBOMManager_LoadData流程分析.md delete mode 100644 reference_docs/clsBOMManager使用说明.md delete mode 100644 reference_docs/combined_output.md delete mode 100644 reference_docs/型号解析与物料匹配系统 - 使用说明.md delete mode 100644 reference_docs/平台配置清单.md delete mode 100644 reference_docs/新增条件提取计划.md delete mode 100644 reference_docs/重构计划-整合领料配置到平台配置清单.md diff --git a/VBA/ClassModules/clsBOMManager.cls b/VBA/ClassModules/clsBOMManager.cls deleted file mode 100644 index bd25b32..0000000 --- a/VBA/ClassModules/clsBOMManager.cls +++ /dev/null @@ -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 \ No newline at end of file diff --git a/VBA/ClassModules/clsCategory.cls b/VBA/ClassModules/clsCategory.cls deleted file mode 100644 index 2ae7ea1..0000000 --- a/VBA/ClassModules/clsCategory.cls +++ /dev/null @@ -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 \ No newline at end of file diff --git a/VBA/ClassModules/clsConditionExtractor.cls b/VBA/ClassModules/clsConditionExtractor.cls deleted file mode 100644 index 39db01d..0000000 --- a/VBA/ClassModules/clsConditionExtractor.cls +++ /dev/null @@ -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 \ No newline at end of file diff --git a/VBA/ClassModules/clsConditionMatcher.cls b/VBA/ClassModules/clsConditionMatcher.cls deleted file mode 100644 index 8581dcb..0000000 --- a/VBA/ClassModules/clsConditionMatcher.cls +++ /dev/null @@ -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 \ No newline at end of file diff --git a/VBA/ClassModules/clsMaterialItem.cls b/VBA/ClassModules/clsMaterialItem.cls deleted file mode 100644 index 00c7b95..0000000 --- a/VBA/ClassModules/clsMaterialItem.cls +++ /dev/null @@ -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系统代码 \ No newline at end of file diff --git a/VBA/ClassModules/clsMaterialWithFlag.cls b/VBA/ClassModules/clsMaterialWithFlag.cls deleted file mode 100644 index c6940b4..0000000 --- a/VBA/ClassModules/clsMaterialWithFlag.cls +++ /dev/null @@ -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 \ No newline at end of file diff --git a/VBA/ClassModules/clsModelParser.cls b/VBA/ClassModules/clsModelParser.cls deleted file mode 100644 index ecb1759..0000000 --- a/VBA/ClassModules/clsModelParser.cls +++ /dev/null @@ -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 \ No newline at end of file diff --git a/VBA/Modules/modBOMProcessor.bas b/VBA/Modules/modBOMProcessor.bas deleted file mode 100644 index d6b8b44..0000000 --- a/VBA/Modules/modBOMProcessor.bas +++ /dev/null @@ -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 \ No newline at end of file diff --git a/VBA/Modules/modModelParserExamples.bas b/VBA/Modules/modModelParserExamples.bas deleted file mode 100644 index b826b6f..0000000 --- a/VBA/Modules/modModelParserExamples.bas +++ /dev/null @@ -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 \ No newline at end of file diff --git a/VBA/Modules/modModelParserTest.bas b/VBA/Modules/modModelParserTest.bas deleted file mode 100644 index 4a4a6c0..0000000 --- a/VBA/Modules/modModelParserTest.bas +++ /dev/null @@ -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 \ No newline at end of file diff --git a/reference_docs/Example1_GeneratePickingListByModel_时序图.md b/reference_docs/Example1_GeneratePickingListByModel_时序图.md deleted file mode 100644 index 9e265e3..0000000 --- a/reference_docs/Example1_GeneratePickingListByModel_时序图.md +++ /dev/null @@ -1,464 +0,0 @@ -# Example1_GeneratePickingListByModel 过程时序图 - -## 过程说明 - -本时序图展示 `Example1_GeneratePickingListByModel` 过程的详细执行流程，该过程根据产品型号生成完整的领料清单。 - ---- - -## 1. 简略版时序图（概览） - -此版本展示主要流程和关键交互，适合快速了解整体架构。 - -```mermaid -sequenceDiagram - autonumber - - participant Main as Example1_Sub - participant BOMMgr as clsBOMManager - participant Excel as Excel工作表 - participant PickList as 型号领料清单表 - participant Parser as 型号解析组件 - participant DataStore as 数据集合 - - %% ==================== 初始化 ==================== - Note over Main: 1. 初始化与加载数据 - Main->>BOMMgr: 创建并初始化 BOMManager - Main->>Excel: 获取配置工作表
(领料配置、平台配置清单) - Main->>BOMMgr: LoadData(wsConfig, wsPlatform) - activate BOMMgr - BOMMgr->>Excel: 读取类别层级和物料数据 - BOMMgr->>DataStore: 构建内存数据结构
(dictCategories, dictAllMaterials) - deactivate BOMMgr - - %% ==================== 创建输出表 ==================== - Note over Main: 2. 创建输出工作表 - Main->>Main: modelStr = "YTHN-100.A0.532.M203.M16.Y3|..." - Main->>Excel: 删除旧工作表(如存在) - Main->>Excel: 创建新工作表 "型号领料清单" - Excel-->>Main: PickList 工作表对象 - - %% ==================== 解析型号 ==================== - Note over Main: 3. 解析型号并提取条件 - Main->>PickList: 写入产品型号标题 - Main->>Parser: ParseModelAndExtractConditions(modelStr) - activate Parser - Parser->>Parser: 解析表头型号(YTHN-100...)
解析表盘型号(BP-095...) - Parser->>DataStore: 提取选择条件
(gclj, jycz, lcfw) - Parser-->>Main: Conditions Dictionary - deactivate Parser - - Main->>PickList: 写入提取条件到工作表 - - %% ==================== 写入表头 ==================== - Note over Main: 4. 写入数据表头 - Main->>PickList: 写入列标题
(类别, 代号, 名称, 数量, 选择条件, 匹配状态) - - %% ==================== 处理物料 ==================== - Note over Main: 5. 遍历类别并匹配物料 - Main->>BOMMgr: GetRootCategories() - BOMMgr-->>Main: 根类别集合 - - loop 每个根类别 - Main->>BOMMgr: GetMaterialsByModel(modelStr, categoryName) - activate BOMMgr - BOMMgr->>DataStore: 获取类别对象 - BOMMgr->>Parser: 匹配物料选择条件 - Parser-->>BOMMgr: 匹配结果集合 - BOMMgr-->>Main: Materials Collection - deactivate BOMMgr - - Note over Main: 写入该类别的所有物料 - loop 每个匹配的物料 - Main->>PickList: 写入物料详细信息
(代号, 名称, 数量, 条件) - end - end - - %% ==================== 完成输出 ==================== - Note over Main: 6. 格式化并完成 - Main->>PickList: AutoFit 格式化 - Main->>Main: 显示完成消息框 -``` - -**简略版特点**： -- **6个参与者**（相比详细版的11个） -- **6个主要阶段**（相比详细版的14个步骤） -- **合并了内部细节**：解析器、提取器、匹配器的内部操作合并为一个组件 -- **简化循环展示**：不展示条件判断、分支逻辑等细节 -- **适合**：快速理解整体流程和架构 - ---- - -## 2. 详细版时序图（完整流程） - -此版本展示每个方法的调用细节、内部逻辑和数据流向，适合深入理解实现。 - -## 时序图 - -```mermaid -sequenceDiagram - autonumber - - participant Main as Example1_Sub - participant BOMMgr as clsBOMManager - participant Workbooks as Excel.Worksheets - participant ConfigWS as 领料配置表 - participant PlatformWS as 平台配置清单表 - participant Parser as clsModelParser - participant Extractor as clsConditionExtractor - participant Matcher as clsConditionMatcher - participant PickListWS as 型号领料清单表 - participant RootCats as 根类别Collection - participant Cat as clsCategory - participant Materials as 物料Collection - participant Conditions as 条件Dictionary - - %% ==================== 初始化阶段 ==================== - Note over Main: 1. 初始化 BOM 管理器 - Main->>BOMMgr: New clsBOMManager - activate BOMMgr - BOMMgr->>BOMMgr: 初始化 dictCategories
初始化 dictAllMaterials
初始化 rootCategories - deactivate BOMMgr - - %% ==================== 加载配置阶段 ==================== - Note over Main: 2. 获取工作表对象 - Main->>Workbooks: Worksheets("领料配置") - Workbooks-->>Main: ConfigWS - Main->>Workbooks: Worksheets("平台配置清单") - Workbooks-->>Main: PlatformWS - - Note over Main: 3. 加载 BOM 数据 - Main->>BOMMgr: LoadData(ConfigWS, PlatformWS) - activate BOMMgr - - BOMMgr->>ConfigWS: 读取类别配置数据
（第2行起：物料代号、类别名称、上层类别） - ConfigWS-->>BOMMgr: 类别层级数据 - - BOMMgr->>BOMMgr: 构建类别树结构
创建 clsCategory 对象
建立父子关系 - - BOMMgr->>PlatformWS: 读取物料清单数据
（第4行起） - PlatformWS-->>BOMMgr: 完整物料数据 - - BOMMgr->>BOMMgr: 创建 clsMaterialItem 对象
填充 dictAllMaterials 字典 - BOMMgr->>BOMMgr: 将物料分配到对应类别
建立 rootCategories 集合 - deactivate BOMMgr - - %% ==================== 准备型号数据 ==================== - Note over Main: 4. 定义产品型号 - Main->>Main: modelStr = "YTHN-100.A0.532.M203.M16.Y3|BP-095.2312.M16.PA3" - - %% ==================== 创建输出工作表 ==================== - Note over Main: 5. 删除旧的领料清单表 - Main->>Workbooks: Worksheets("型号领料清单") - alt 工作表存在 - Workbooks-->>Main: 工作表对象 - Main->>PickListWS: Delete - else 工作表不存在 - Workbooks-->>Main: 错误 - Main->>Main: On Error Resume Next (忽略错误) - end - - Note over Main: 6. 创建新工作表 - Main->>Workbooks: Worksheets.Add() - Workbooks-->>Main: PickListWS - Main->>PickListWS: Name = "型号领料清单" - - %% ==================== 写入标题行 ==================== - Note over Main: 7. 写入产品型号 - Main->>Main: row = 1 - Main->>PickListWS: Cells(row, 1).value = "产品型号" - Main->>PickListWS: Cells(row, 2).value = modelStr - Main->>Main: row = row + 1 - - %% ==================== 解析型号并提取条件 ==================== - Note over Main: 8. 解析型号提取条件 - Main->>BOMMgr: ParseModelAndExtractConditions(modelStr) - activate BOMMgr - - BOMMgr->>Parser: New clsModelParser - activate Parser - BOMMgr->>Parser: ParseModel(modelStr) - - Note over Parser: 解析表头型号 - Parser->>Parser: 提取型号前缀: "YTHN" - Parser->>Parser: 提取公称外径: "100" - Parser->>Parser: 提取安装形式: "A0" - Parser->>Parser: 提取壳体形式: "532" - Parser->>Parser: 提取过程连接: "M203" - Parser->>Parser: 提取量程范围: "M16" - Parser->>Parser: 提取仪表特性: "Y3" - - Note over Parser: 解析表盘型号 - Parser->>Parser: 提取表盘型号: "BP-095" - Parser->>Parser: 提取表盘规格: "2312" - Parser->>Parser: 提取表盘连接: "M16" - Parser->>Parser: 提取表盘特性: "PA3" - - Parser-->>BOMMgr: True (解析成功) - deactivate Parser - - BOMMgr->>Extractor: New clsConditionExtractor - activate Extractor - BOMMgr->>Extractor: ExtractConditions(Parser) - - Note over Extractor: 应用提取规则 - Extractor->>Extractor: 规则1: gclj = 过程连接 = "M203" - Extractor->>Extractor: 规则2: jycz = 接液材质 = "M16" - Extractor->>Extractor: 规则3: lcfw = 量程范围 = "M16" - Extractor->>Extractor: 创建条件字典 - - Extractor-->>BOMMgr: Conditions Dictionary - deactivate Extractor - - BOMMgr-->>Main: Conditions Dictionary - deactivate BOMMgr - - %% ==================== 写入提取条件 ==================== - Note over Main: 9. 写入提取条件行 - Main->>PickListWS: Cells(row, 1).value = "提取条件" - - Note over Main: 遍历条件字典拼接字符串 - Main->>Conditions: 遍历 Keys - loop 每个条件键值对 - Conditions-->>Main: key, value - Main->>Main: 拼接条件字符串到 condStr - end - - Main->>PickListWS: Cells(row, 2).value = condStr - Main->>Main: row = row + 2 - - %% ==================== 写入表头 ==================== - Note over Main: 10. 写入数据表头 - Main->>PickListWS: Cells(row, 1).value = "类别" - Main->>PickListWS: Cells(row, 2).value = "代号" - Main->>PickListWS: Cells(row, 3).value = "名称" - Main->>PickListWS: Cells(row, 4).value = "数量" - Main->>PickListWS: Cells(row, 5).value = "选择条件" - Main->>PickListWS: Cells(row, 6).value = "匹配状态" - Main->>PickListWS: 设置表头字体为粗体 (Range A-F) - Main->>Main: row = row + 1 - - %% ==================== 获取根类别 ==================== - Note over Main: 11. 获取根类别集合 - Main->>BOMMgr: GetRootCategories() - BOMMgr-->>Main: RootCats Collection - - %% ==================== 外层循环：遍历根类别 ==================== - Note over Main: 12. 遍历每个根类别 - loop 每个根类别 i = 1 To RootCats.Count - - Main->>RootCats: Item(i) - RootCats-->>Main: Cat - - Note over Main: 获取类别名称 - Main->>Cat: .categoryName - Cat-->>Main: categoryName - - Note over Main: 获取该类别符合条件的物料 - Main->>BOMMgr: GetMaterialsByModel(modelStr, categoryName) - activate BOMMgr - - BOMMgr->>Matcher: New clsConditionMatcher - activate Matcher - - Note over BOMMgr: 从 dictCategories 获取类别 - BOMMgr->>BOMMgr: dictCategories(categoryName) - BOMMgr-->>BOMMgr: Category 对象 - - Note over BOMMgr: 遍历类别下的所有物料 - BOMMgr->>Cat: .materials (Collection) - - loop 每个物料 - Cat-->>BOMMgr: MaterialItem - - Note over BOMMgr: 检查物料选择条件 - BOMMgr->>MaterialItem: .Condition - - alt 物料有选择条件 - MaterialItem-->>BOMMgr: conditionStr - - Note over BOMMgr,Matcher: 匹配条件 - BOMMgr->>Matcher: Match(conditionStr, Conditions) - - Matcher->>Matcher: 解析条件表达式
（AND, OR, !=, 括号） - Matcher->>Conditions: 获取变量值 - Conditions-->>Matcher: 变量值 - - Matcher->>Matcher: 评估逻辑表达式 - Matcher-->>BOMMgr: True/False (匹配结果) - - alt 匹配成功 - BOMMgr->>BOMMgr: 添加到结果集合 - end - else 物料无条件 - MaterialItem-->>BOMMgr: "" - BOMMgr->>BOMMgr: 直接添加到结果集合 - end - end - - BOMMgr-->>Main: Materials Collection - deactivate Matcher - deactivate BOMMgr - - %% ==================== 内层循环：遍历物料写入 ==================== - Note over Main: 写入该类别的所有物料 - loop 每个物料 j = 1 To Materials.Count - - Main->>Materials: Item(j) - Materials-->>Main: mat (clsMaterialItem) - - Note over Main: 写入物料详细信息 - Main->>PickListWS: Cells(row, 1).value = categoryName - Main->>PickListWS: Cells(row, 2).value = mat.code - Main->>PickListWS: Cells(row, 3).value = mat.Name - Main->>PickListWS: Cells(row, 4).value = mat.Quantity - - Main->>mat: .Condition - mat-->>Main: condition - - alt condition = "" - Main->>PickListWS: Cells(row, 5).value = "(无条件)" - else condition <> "" - Main->>PickListWS: Cells(row, 5).value = condition - end - - Main->>PickListWS: Cells(row, 6).value = "✓" - Main->>Main: row = row + 1 - - end - - end - - %% ==================== 格式化输出 ==================== - Note over Main: 13. 格式化工作表 - Main->>PickListWS: Columns("A:F").AutoFit - - %% ==================== 显示完成消息 ==================== - Note over Main: 14. 显示完成消息框 - Main->>Main: MsgBox("领料清单生成完成！\n请查看工作表: 型号领料清单") - - Note over Main: 过程结束 -``` - -## 流程阶段说明 - -### 阶段 1: 初始化与数据加载 (步骤 1-3) -- 创建 BOM 管理器实例 -- 从 Excel 获取配置工作表 -- 加载类别层级和物料数据，构建内存数据结构 - -### 阶段 2: 工作表准备 (步骤 4-7) -- 定义产品型号字符串 -- 删除旧的输出工作表（带错误处理） -- 创建新的"型号领料清单"工作表 -- 写入产品型号标题 - -### 阶段 3: 型号解析与条件提取 (步骤 8-9) -- 使用 ModelParser 解析复杂型号字符串 - - 表头型号：YTHN-100.A0.532.M203.M16.Y3 - - 表盘型号：BP-095.2312.M16.PA3 -- 使用 ConditionExtractor 提取物料选择条件 -- 将条件字典写入输出表 - -### 阶段 4: 数据表头 (步骤 10-11) -- 写入数据列标题：类别、代号、名称、数量、选择条件、匹配状态 -- 获取根类别集合 - -### 阶段 5: 物料匹配与写入 (步骤 12) -- **外层循环**：遍历每个根类别 -- **物料匹配**：对每个类别调用 GetMaterialsByModel - - 遍历类别下所有物料 - - 使用 ConditionMatcher 评估每个物料的选择条件 - - 筛选符合条件的物料 -- **内层循环**：遍历匹配的物料集合 - - 写入物料的详细信息（代号、名称、数量等） - - 显示选择条件和匹配状态 - -### 阶段 6: 格式化与完成 (步骤 13-14) -- 自动调整列宽 -- 显示完成消息框 - -## 关键数据结构 - -### 输入数据 -- **产品型号**: "YTHN-100.A0.532.M203.M16.Y3|BP-095.2312.M16.PA3" -- **配置工作表**: "领料配置"、"平台配置清单" - -### 中间数据 -- **Conditions Dictionary**: {gclj: "M203", jycz: "M16", lcfw: "M16"} -- **RootCategories Collection**: 所有顶层类别 -- **Materials Collection**: 每个类别匹配的物料 - -### 输出数据 -- **型号领料清单表**: 包含产品型号、提取条件、物料清单 - -## 性能考虑 - -- 使用 Dictionary 和 Collection 提高查找效率 -- 嵌套循环结构：根类别 × 物料 -- 大量 Excel 单元格写入操作（可考虑批量写入优化） - -## 扩展建议 - -1. **批量写入优化**: 将数据先存入数组，一次性写入工作表 -2. **进度显示**: 添加处理进度条 -3. **错误处理**: 增强型号解析失败、数据缺失等异常处理 -4. **参数化**: 将型号作为参数传入，增加灵活性 -5. **日志记录**: 记录处理过程和匹配统计信息 - ---- - -## 3. 两个版本的对比 - -### 复杂度对比 - -| 特性 | 简略版 | 详细版 | -|------|--------|--------| -| **参与者数量** | 6个 | 11个 | -| **主要阶段** | 6个 | 14个步骤 | -| **交互步骤** | 约35步 | 约80步 | -| **循环展开** | 简化展示 | 完整展示内部逻辑 | -| **条件分支** | 隐藏 | 详细展示 (alt/opt/loop) | -| **内部方法调用** | 合并展示 | 逐个展开 | - -### 适用场景 - -#### 简略版适用于： -- 📌 **初次了解**：快速掌握整体流程和架构 -- 📌 **高层汇报**：向非技术人员展示系统工作原理 -- 📌 **文档概览**：作为技术文档的目录或概述部分 -- 📌 **快速参考**：复习主要步骤和组件关系 - -#### 详细版适用于： -- 🔍 **代码调试**：理解具体实现细节和数据流向 -- 🔍 **代码审查**：检查逻辑错误和性能瓶颈 -- 🔍 **新人培训**：深入讲解系统实现机制 -- 🔍 **维护文档**：作为详细技术文档保存 - -### 组件对应关系 - -| 简略版组件 | 详细版组件 | -|------------|------------| -| Excel工作表 | Workbooks + ConfigWS + PlatformWS + PickListWS | -| 型号解析组件 | Parser + Extractor + Matcher | -| 数据集合 | RootCats + Cat + Materials + Conditions | - -### 阶段对应关系 - -| 简略版阶段 | 详细版步骤 | -|------------|------------| -| 1. 初始化与加载数据 | 1-3: 初始化、获取工作表、加载数据 | -| 2. 创建输出工作表 | 4-7: 定义型号、删除旧表、创建新表、写入标题 | -| 3. 解析型号并提取条件 | 8-9: 解析型号、提取条件、写入条件行 | -| 4. 写入数据表头 | 10-11: 写入列标题、获取根类别 | -| 5. 遍历类别并匹配物料 | 12: 外层循环（类别）、内层循环（物料）、条件匹配 | -| 6. 格式化并完成 | 13-14: 格式化工作表、显示消息框 | - ---- - -## 使用建议 - -1. **学习路径**：先看简略版建立整体概念，再看详细版理解实现细节 -2. **文档组织**：简略版放在文档开头作为概述，详细版放在后面作为参考 -3. **演示场景**：简略版适合PPT演示，详细版适合技术讲解 -4. **版本维护**：代码变更时，优先更新详细版，然后同步更新简略版的主要流程 diff --git a/reference_docs/clsBOMManager_LoadData流程分析-v2(整合后).md b/reference_docs/clsBOMManager_LoadData流程分析-v2(整合后).md deleted file mode 100644 index 9fcf6ff..0000000 --- a/reference_docs/clsBOMManager_LoadData流程分析-v2(整合后).md +++ /dev/null @@ -1,530 +0,0 @@ -# clsBOMManager.LoadData 方法流程分析 (v2.0 - 整合后版本) - -## 方法概述 - -`LoadData` 是 `clsBOMManager` 类的核心方法，负责从 [平台配置清单] 工作表加载 BOM 数据并构建完整的层级数据结构。 - -**v2.0 变更说明**： -- 移除了 [领料配置] 表的依赖 -- 所有配置数据统一从 [平台配置清单] 读取 -- 新增"类别选用条件"字段，支持动态判断类别是否需要 -- 新增"66代码"字段 - -## 方法签名 - -```vba -Public Sub LoadData(wsPlatform As Worksheet) -``` - -### 参数说明 - -| 参数 | 类型 | 说明 | -|------|------|------| -| `wsPlatform` | Worksheet | [平台配置清单]工作表，包含完整的物料信息和类别配置 | - -## 整体流程图 - -```mermaid -flowchart TD - Start([开始 LoadData]) --> Step1[第一步: 从平台配置清单加载所有物料和类别信息] - Step1 --> Step2[第二步: 建立类别层级关系] - Step2 --> End([结束]) - - style Start fill:#e1f5e1 - style End fill:#ffe1e1 - style Step1 fill:#e1f0ff - style Step2 fill:#fff4e1 -``` - -## 详细流程分析 - -### 第一步：从平台配置清单加载所有物料和类别信息 - -```mermaid -flowchart TD - S1_Start([开始第一步]) --> S1_Init[初始化: 获取最后一行行号] - S1_Init --> S1_Loop{循环 i = 4 到 lastRow} - S1_Loop -->|i += 1| S1_ReadMat[读取物料基础信息
C列:代号, D列:名称
E列:数量, F列:选择条件] - S1_ReadMat --> S1_ReadCat[读取类别信息
H列:类别, I列:上层类别
J列:类别选用条件, K列:66代码] - S1_ReadCat --> S1_CreateMat[创建 clsMaterialItem 对象] - S1_CreateMat --> S1_SetMatProps[设置物料属性
code, Name, Quantity, Condition
Category, ParentCategory
CategorySelectCondition, Code66] - S1_SetMatProps --> S1_SaveMat[保存到 dictAllMaterials] - S1_SaveMat --> S1_CheckCat{类别字段
是否为空?} - S1_CheckCat -->|否, 有类别| S1_EnsureCat{类别对象
是否存在?} - S1_CheckCat -->|是, 无类别| S1_Next - S1_EnsureCat -->|不存在| S1_CreateCat[创建新类别对象
设置 categoryName, ParentCategoryName
CategorySelectCondition] - S1_EnsureCat -->|已存在| S1_AddMat - S1_CreateCat --> S1_AddMat[将物料添加到类别] - S1_AddMat --> S1_Next - S1_Next --> S1_Loop - S1_Loop -->|i > lastRow| S1_End([第一步完成]) - - style S1_Start fill:#e1f5e1 - style S1_End fill:#ffe1e1 - style S1_CreateCat fill:#bbdefb - style S1_AddMat fill:#c8e6c9 - style S1_CheckCat fill:#fff9c4 -``` - -**数据来源**：[平台配置清单] 工作表 - -| 列 | 字段 | 说明 | -|----|------|------| -| C | code | 物料代号 | -| D | Name | 物料名称 | -| E | Quantity | 物料数量 | -| F | Condition | 选择条件 | -| H | Category | 类别名称 | -| I | ParentCategoryName | 上层类别名称 | -| J | CategorySelectCondition | 类别选用条件 | -| K | Code66 | 66系统代码 | - -**数据结构**： -``` -dictAllMaterials: Dictionary -├── "01011009557" → clsMaterialItem{ -│ code: "01011009557" -│ Name: "径向低压接头部件" -│ Quantity: 1.0 -│ Condition: "gclj=M20 AND jycz=1" -│ Category: "部件" -│ ParentCategory: "" -│ CategorySelectCondition: "" -│ Code66: "66021009557" -│ } -└── ... - -dictCategories: Dictionary -├── "部件" → clsCategory{ -│ categoryName: "部件" -│ ParentCategoryName: "" -│ CategorySelectCondition: "" -│ materials: Collection -│ SubCategories: Collection -│ } -└── ... -``` - -**关键代码**： -```vba -lastRow = wsPlatform.Cells(wsPlatform.Rows.Count, "C").End(xlUp).row - -For i = 4 To lastRow - ' 1. 创建物料对象并读取基础信息 - Set mat = New clsMaterialItem - mat.code = Trim(wsPlatform.Cells(i, "C").value & "") - mat.Name = Trim(wsPlatform.Cells(i, "D").value & "") - mat.Quantity = CDbl(wsPlatform.Cells(i, "E").value) - mat.Condition = Trim(wsPlatform.Cells(i, "F").value & "") - - ' 2. 读取类别相关字段 - 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 & "") - - ' 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 -``` - -**与 v1.0 的区别**： - -| 特性 | v1.0 (旧版本) | v2.0 (新版本) | -|------|--------------|--------------| -| 数据源 | [平台配置清单] + [领料配置] | 仅 [平台配置清单] | -| 加载步骤 | 3步 (先物料，后类别，再层级) | 2步 (物料类别一起加载，再层级) | -| 参数 | wsConfig, wsPlatform | wsPlatform | -| 类别选用条件 | 不支持 | 支持 | -| 66代码 | 不支持 | 支持 | - ---- - -### 第二步：建立类别层级关系 - -```mermaid -flowchart TD - S2_Start([开始第二步]) --> S2_Loop{遍历 dictCategories
所有键} - S2_Loop -->|下一个键| S2_GetCat[获取类别对象 cat] - S2_GetCat --> S2_CheckParent{ParentCategoryName
是否为空?} - S2_CheckParent -->|否, 有父类别| S2_ParentExists{父类别
存在?} - S2_CheckParent -->|是, 无父类别| S2_AddRoot[添加到 rootCategories
作为根类别] - S2_ParentExists -->|是| S2_AddSub[添加到父类别的
SubCategories 集合] - S2_ParentExists -->|否| S2_Orphan[父类别不存在
跳过建立关系] - S2_AddRoot --> S2_Next - S2_AddSub --> S2_Next - S2_Orphan --> S2_Next - S2_Next --> S2_Loop - S2_Loop -->|遍历完成| S2_End([第二步完成]) - - style S2_Start fill:#e1f5e1 - style S2_End fill:#ffe1e1 - style S2_AddRoot fill:#ffccbc - style S2_AddSub fill:#b2dfdb -``` - -**数据结构**： -``` -rootCategories: Collection -├── "表壳" (根类别) -│ └── CategorySelectCondition: "" (总是需要) -├── "部件" (根类别) -│ └── CategorySelectCondition: "" (总是需要) -│ └── SubCategories: -│ ├── "接头" (子类别) -│ │ └── CategorySelectCondition: "gclj=M20" (条件性需要) -│ └── "弹性元件" (子类别) -│ └── CategorySelectCondition: "lcfw=M02" (条件性需要) -└── "机芯" (根类别) - └── CategorySelectCondition: "jycz=1" (条件性需要) -``` - -**关键代码**： -```vba -For Each key In dictCategories.Keys - Set cat = dictCategories(key) - If cat.ParentCategoryName <> "" Then - If dictCategories.Exists(cat.ParentCategoryName) Then - Set parentCat = dictCategories(cat.ParentCategoryName) - parentCat.AddSubCategory cat - End If - Else - rootCategories.Add cat, cat.categoryName - End If -Next key -``` - -**说明**：此步骤与 v1.0 版本相同，未发生变化。 - ---- - -## 数据结构总结 - -### 类的私有成员变量 - -```mermaid -classDiagram - class clsBOMManager { - -dictCategories: Dictionary - -dictAllMaterials: Dictionary - -rootCategories: Collection - +LoadData(wsPlatform) - +GetRootCategories() Collection - +GetCategory(categoryName) clsCategory - +GetRequiredCategories(conditions) Collection - +GetValidMaterialsByModel(modelStr) Collection - } - - class clsCategory { - +categoryName: String - +ParentCategoryName: String - +CategorySelectCondition: String - +materials: Collection - +SubCategories: Collection - +IsLeafCategory: Boolean - +AddMaterial(mat) - +AddSubCategory(cat) - +IsRequiredForModel(conditions) Boolean - +HasSubCategories() Boolean - } - - class clsMaterialItem { - +code: String - +Name: String - +Quantity: Double - +Condition: String - +Category: String - +ParentCategory: String - +CategorySelectCondition: String - +Code66: String - } - - clsBOMManager "1" --> "*" clsCategory : 管理 - clsCategory "1" --> "*" clsMaterialItem : 包含 - clsCategory "1" --> "*" clsCategory : 父子关系 -``` - -### 三个核心数据容器 - -| 数据容器 | 类型 | 键/索引 | 值 | 用途 | -|---------|------|---------|-----|------| -| `dictAllMaterials` | Dictionary | 物料代号 (String) | clsMaterialItem | 快速查找任意物料的完整信息 | -| `dictCategories` | Dictionary | 类别名称 (String) | clsCategory | 快速查找任意类别 | -| `rootCategories` | Collection | 索引 (Long) | clsCategory | 遍历完整的类别树结构 | - ---- - -## 流程时序图 - -```mermaid -sequenceDiagram - participant Caller as 调用者 - participant LoadData as LoadData方法 - participant WSPlatform as [平台配置清单] - participant DictMat as dictAllMaterials - participant DictCat as dictCategories - participant RootCats as rootCategories - - Caller->>LoadData: LoadData(wsPlatform) - - Note over LoadData, WSPlatform: 第一步: 加载物料和类别信息 - LoadData->>WSPlatform: 读取第4-末行 - WSPlatform-->>LoadData: 返回物料和类别数据 - loop 每一行数据 - LoadData->>DictMat: 创建/添加物料 (包含新字段) - alt 类别字段不为空 - LoadData->>DictCat: 类别存在? - alt 类别不存在 - LoadData->>DictCat: 创建新类别(含类别选用条件) - end - LoadData->>DictCat: 添加物料到类别 - end - end - - Note over LoadData, RootCats: 第二步: 构建层级树 - loop 遍历所有类别 - LoadData->>DictCat: 获取类别 - alt 有父类别 - LoadData->>DictCat: 添加到父类别的SubCategories - else 无父类别 - LoadData->>RootCats: 添加为根类别 - end - end - - LoadData-->>Caller: 完成 -``` - ---- - -## 重要业务规则 - -### 1. 物料筛选规则 -- ✅ 类别字段不为空的物料 → **需要领料**，会被添加到类别中 -- ❌ 类别字段为空的物料 → **不需要领料**，仅在 `dictAllMaterials` 中保存 - -### 2. 类别选用条件规则（v2.0 新增） -- ✅ 类别选用条件为空 → 该类别**总是需要**（无条件限制） -- ⚡ 类别选用条件不为空 → 需要用型号条件去匹配 - - 匹配成功 → 该类别需要 - - 匹配失败 → 该类别不需要 - -### 3. 类别层级规则 -- 根类别：`ParentCategoryName` 为空字符串 `""` -- 子类别：`ParentCategoryName` 指向父类别名称 -- 层级深度：无限制（支持任意深度的树形结构） - -### 4. 数据一致性 -- 所有物料必须从 [平台配置清单] 读取 -- 类别字段和类别选用条件字段同时存在 -- 一个物料只能属于一个类别 - ---- - -## 使用示例 - -### 调用 LoadData - -```vba -Dim bomMgr As New clsBOMManager -Dim wsPlatform As Worksheet - -Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单") - -' 加载数据 (v2.0 只需要一个参数) -Call bomMgr.LoadData(wsPlatform) - -' 获取根类别 -Dim rootCats As Collection -Set rootCats = bomMgr.GetRootCategories() - -' 遍历所有根类别 -Dim i As Long -For i = 1 To rootCats.Count - Debug.Print "根类别: " & rootCats(i).categoryName - Debug.Print "类别选用条件: " & rootCats(i).CategorySelectCondition -Next i -``` - -### 使用类别选用条件 - -```vba -' 解析型号并提取条件 -Dim conditions As Object -Set conditions = bomMgr.ParseModelAndExtractConditions("YTHN-100.A0.532.M203.M16.Y3") - -' 获取需要的类别 -Dim requiredCats As Collection -Set requiredCats = bomMgr.GetRequiredCategories(conditions) - -' 遍历需要的类别 -Dim cat As clsCategory -For Each cat In requiredCats - Debug.Print "需要的类别: " & cat.categoryName -Next cat -``` - ---- - -## 执行后的数据结构示例 - -假设加载后的数据结构如下： - -``` -型号: YTHN-100.A0.532.M203.M16.Y3 -提取的条件: lcfw=M16, gclj=M20, jycz=1, azxs=A0 - -dictAllMaterials: -{ - "01011009557" → { - code: "01011009557", - Name: "径向低压接头部件", - Quantity: 1.0, - Condition: "gclj=M20 AND jycz=1 AND lcfw=M01", - Category: "部件", - ParentCategory: "", - CategorySelectCondition: "", - Code66: "66021009557" - } -} - -dictCategories: -{ - "部件" → { - categoryName: "部件", - ParentCategoryName: "", - CategorySelectCondition: "", - materials: [...], - SubCategories: ["接头", "弹性元件"] - }, - "接头" → { - categoryName: "接头", - ParentCategoryName: "部件", - CategorySelectCondition: "gclj=M20", ← 类别选用条件 - materials: [...], - SubCategories: [] - }, - "机芯" → { - categoryName: "机芯", - ParentCategoryName: "", - CategorySelectCondition: "jycz=1", ← 类别选用条件 - materials: [...], - SubCategories: [] - } -} - -判断哪些类别需要: -- "部件" → CategorySelectCondition="" → 总是需要 ✓ -- "接头" → CategorySelectCondition="gclj=M20" → 型号有gclj=M20 → 需要 ✓ -- "机芯" → CategorySelectCondition="jycz=1" → 型号有jycz=1 → 需要 ✓ - -requiredCategories = ["部件", "接头", "机芯"] -``` - ---- - -## 错误处理 - -LoadData 方法本身不包含显式的错误处理（`On Error`），依赖以下机制： - -1. **空值处理**：使用 `& ""` 确保字符串转换不会失败 -2. **类型转换**：使用 `CDbl()` 时没有错误处理，假设数据格式正确 -3. **跳过机制**：物料代号为空时，不保存到字典 -4. **存在性检查**：使用 `Dictionary.Exists()` 避免键不存在错误 - ---- - -## 相关方法 - -LoadData 执行后，可以使用以下方法访问数据： - -| 方法 | 说明 | v2.0变化 | -|------|------|---------| -| `GetRootCategories()` | 获取所有顶层类别 | 无变化 | -| `GetCategory(categoryName)` | 根据名称获取类别对象 | 无变化 | -| `GetRequiredCategories(conditions)` | ⭐ 获取需要的类别列表 | 新增 | -| `GetValidMaterialsByModel()` | 获取物料并检查完整性 | ⭐ 已重构，使用类别选用条件 | -| `GetMaterialsByModel()` | 根据型号获取物料 | 无变化 | -| `PrintCategoryTree()` | 打印类别树（调试用） | 无变化 | - ---- - -## 迁移指南 (v1.0 → v2.0) - -### 代码变更 - -**旧代码 (v1.0)**： -```vba -Dim wsConfig As Worksheet -Dim wsPlatform As Worksheet -Set wsConfig = ThisWorkbook.Worksheets("领料配置") -Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单") - -Call bomMgr.LoadData(wsConfig, wsPlatform) ' 两个参数 -``` - -**新代码 (v2.0)**： -```vba -Dim wsPlatform As Worksheet -Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单") - -Call bomMgr.LoadData(wsPlatform) ' 一个参数 -``` - -### 数据变更 - -**旧表结构**： -- [领料配置]: A列=代号, C列=类别, D列=上层类别 -- [平台配置清单]: C列=代号, D列=名称, E列=数量, F列=选择条件 - -**新表结构**： -- [平台配置清单]: C列=代号, D列=名称, E列=数量, F列=选择条件 - H列=类别, I列=上层类别, J列=类别选用条件, K列=66代码 - -### 逻辑变更 - -**完整性检查逻辑**： -- **v1.0**: 所有根类别都必须匹配到物料 -- **v2.0**: 只检查需要的类别（通过类别选用条件判断） - ---- - -## 总结 - -`LoadData` 方法（v2.0）通过两个阶段构建完整的 BOM 数据结构： - -1. **数据加载**：从 [平台配置清单] 一次性加载所有物料和类别信息（包括新增的类别选用条件和66代码） -2. **结构构建**：构建类别的树形层级关系 - -v2.0 的主要改进： -- ✅ 简化数据源：从一个表读取所有数据 -- ✅ 支持动态类别判断：通过类别选用条件 -- ✅ 更精确的完整性检查：只检查需要的类别 -- ✅ 支持66系统：新增66代码字段 - -最终形成的数据结构支持： -- 快速按代号查找物料 -- 快速按类别查找物料 -- 遍历完整的类别树 -- 根据型号动态确定需要的类别 -- 支持父类别/子类别的领料逻辑 diff --git a/reference_docs/clsBOMManager_LoadData流程分析.md b/reference_docs/clsBOMManager_LoadData流程分析.md deleted file mode 100644 index 837de1f..0000000 --- a/reference_docs/clsBOMManager_LoadData流程分析.md +++ /dev/null @@ -1,439 +0,0 @@ -# clsBOMManager.LoadData 方法流程分析 - -## 方法概述 - -`LoadData` 是 `clsBOMManager` 类的核心方法，负责从 Excel 工作表加载 BOM 数据并构建完整的层级数据结构。 - -## 方法签名 - -```vba -Public Sub LoadData(wsConfig As Worksheet, wsPlatform As Worksheet) -``` - -### 参数说明 - -| 参数 | 类型 | 说明 | -|------|------|------| -| `wsConfig` | Worksheet | [领料配置]工作表，包含类别层级和需要领料的物料 | -| `wsPlatform` | Worksheet | [平台配置清单]工作表，包含完整的物料信息 | - -## 整体流程图 - -```mermaid -flowchart TD - Start([开始 LoadData]) --> Step1[第一步: 加载物料基础信息] - Step1 --> Step2[第二步: 加载类别信息并关联物料] - Step2 --> Step3[第三步: 建立类别层级关系] - Step3 --> End([结束]) - - style Start fill:#e1f5e1 - style End fill:#ffe1e1 - style Step1 fill:#e1f0ff - style Step2 fill:#fff4e1 - style Step3 fill:#f0e1ff -``` - -## 详细流程分析 - -### 第一步：从平台配置清单加载所有物料的基础信息 - -```mermaid -flowchart TD - S1_Start([开始第一步]) --> S1_Init[初始化: 获取最后一行行号] - S1_Init --> S1_Loop{循环 i = 4 到 lastRow} - S1_Loop -->|i += 1| S1_Read[读取第 i 行数据] - S1_Read --> S1_Create[创建 clsMaterialItem 对象] - S1_Create --> S1_Assign[赋值: code, Name, Quantity, Condition] - S1_Assign --> S1_Check{code 是否非空?} - S1_Check -->|是| S1_Add[添加到 dictAllMaterials
键: code, 值: mat] - S1_Check -->|否| S1_Next[跳过] - S1_Add --> S1_Next - S1_Next --> S1_Loop - S1_Loop -->|i > lastRow| S1_End([第一步完成]) - - style S1_Start fill:#e1f5e1 - style S1_End fill:#ffe1e1 - style S1_Add fill:#c8e6c9 - style S1_Check fill:#fff9c4 -``` - -**数据来源**：[平台配置清单] 工作表 - -| 列 | 字段 | 说明 | -|----|------|------| -| C | code | 物料代号 | -| D | Name | 物料名称 | -| E | Quantity | 物料数量 | -| F | Condition | 选择条件 | - -**数据结构**： -``` -dictAllMaterials: Dictionary -├── "01011019001" → clsMaterialItem{code, Name, Quantity, Condition} -├── "01081013833" → clsMaterialItem{...} -└── ... -``` - -**关键代码**： -```vba -lastRow = wsPlatform.Cells(wsPlatform.Rows.Count, "C").End(xlUp).row -For i = 4 To lastRow - Set mat = New clsMaterialItem - mat.code = Trim(wsPlatform.Cells(i, "C").value & "") - mat.Name = Trim(wsPlatform.Cells(i, "D").value & "") - mat.Quantity = CDbl(wsPlatform.Cells(i, "E").value) - mat.Condition = Trim(wsPlatform.Cells(i, "F").value & "") - - If mat.code <> "" Then - Set dictAllMaterials(mat.code) = mat - End If -Next i -``` - ---- - -### 第二步：从领料配置加载类别信息并关联物料 - -```mermaid -flowchart TD - S2_Start([开始第二步]) --> S2_Init[初始化: 获取最后一行行号] - S2_Init --> S2_Loop{循环 i = 2 到 lastRow} - S2_Loop -->|i += 1| S2_Read[读取第 i 行数据
code, catName, parentCatName] - S2_Read --> S2_CheckCode{code 是否为空?} - S2_CheckCode -->|是| S2_NextRow[跳到下一行] - S2_CheckCode -->|否| S2_CheckCat{类别是否已存在?} - S2_CheckCat -->|否| S2_CreateCat[创建新的 clsCategory 对象
设置 categoryName 和 ParentCategoryName
添加到 dictCategories] - S2_CheckCat -->|是| S2_Exists[类别已存在] - S2_CreateCat --> S2_CheckMat{物料在
dictAllMaterials?} - S2_Exists --> S2_CheckMat - S2_CheckMat -->|是| S2_UpdateMat[更新物料信息:
mat.Category = catName
mat.ParentCategory = parentCatName
添加到类别 materials 集合] - S2_CheckMat -->|否| S2_SkipMat[物料不在库中,跳过] - S2_UpdateMat --> S2_NextRow - S2_SkipMat --> S2_NextRow - S2_NextRow --> S2_Loop - S2_Loop -->|i > lastRow| S2_End([第二步完成]) - - style S2_Start fill:#e1f5e1 - style S2_End fill:#ffe1e1 - style S2_CreateCat fill:#bbdefb - style S2_UpdateMat fill:#c8e6c9 - style S2_CheckCat fill:#fff9c4 - style S2_CheckMat fill:#fff9c4 -``` - -**数据来源**：[领料配置] 工作表 - -| 列 | 字段 | 说明 | -|----|------|------| -| A | code | 物料代号 | -| C | catName | 类别名称 | -| D | parentCatName | 上层类别名称 | - -**数据结构**： -``` -dictCategories: Dictionary -├── "表壳" → clsCategory{categoryName, materials[], SubCategories[]} -├── "部件" → clsCategory{...} -└── ... -``` - -**关键代码**： -```vba -lastRow = wsConfig.Cells(wsConfig.Rows.Count, "A").End(xlUp).row -For i = 2 To lastRow - code = Trim(wsConfig.Cells(i, "A").value & "") - catName = Trim(wsConfig.Cells(i, "C").value & "") - parentCatName = Trim(wsConfig.Cells(i, "D").value & "") - - If code = "" Then GoTo NextRow - - If Not dictCategories.Exists(catName) Then - Set cat = New clsCategory - cat.categoryName = catName - cat.ParentCategoryName = parentCatName - Set dictCategories(catName) = cat - End If - - If dictAllMaterials.Exists(code) Then - Set mat = dictAllMaterials(code) - mat.Category = catName - mat.ParentCategory = parentCatName - dictCategories(catName).AddMaterial mat - End If -Next i -``` - -**业务逻辑说明**： -- 只有出现在 [领料配置] 中的物料才会被添加到类别中 -- 未在 [领料配置] 中的物料表示不需要领料 - ---- - -### 第三步：建立类别层级关系 - -```mermaid -flowchart TD - S3_Start([开始第三步]) --> S3_Loop{遍历 dictCategories
所有键} - S3_Loop -->|下一个键| S3_GetCat[获取类别对象 cat] - S3_GetCat --> S3_CheckParent{ParentCategoryName
是否为空?} - S3_CheckParent -->|否, 有父类别| S3_ParentExists{父类别
存在?} - S3_CheckParent -->|是, 无父类别| S3_AddRoot[添加到 rootCategories
作为根类别] - S3_ParentExists -->|是| S3_AddSub[添加到父类别的
SubCategories 集合] - S3_ParentExists -->|否| S3_Orphan[父类别不存在
跳过建立关系] - S3_AddRoot --> S3_Next - S3_AddSub --> S3_Next - S3_Orphan --> S3_Next - S3_Next --> S3_Loop - S3_Loop -->|遍历完成| S3_End([第三步完成]) - - style S3_Start fill:#e1f5e1 - style S3_End fill:#ffe1e1 - style S3_AddRoot fill:#ffccbc - style S3_AddSub fill:#b2dfdb -``` - -**数据结构**： -``` -rootCategories: Collection -├── "表壳" (根类别) -├── "部件" (根类别) -│ └── SubCategories: -│ ├── "接头" (子类别) -│ └── "弹性元件" (子类别) -└── "机芯" (根类别) -``` - -**关键代码**： -```vba -For Each key In dictCategories.Keys - Set cat = dictCategories(key) - If cat.ParentCategoryName <> "" Then - If dictCategories.Exists(cat.ParentCategoryName) Then - Set parentCat = dictCategories(cat.ParentCategoryName) - parentCat.AddSubCategory cat - End If - Else - rootCategories.Add cat, cat.categoryName - End If -Next key -``` - -**层级关系构建逻辑**： -1. 遍历所有类别 -2. 如果类别有父类别 → 建立父子关系（调用父类别的 `AddSubCategory` 方法） -3. 如果类别无父类别 → 作为根类别，添加到 `rootCategories` - ---- - -## 数据结构总结 - -### 类的私有成员变量 - -```mermaid -classDiagram - class clsBOMManager { - -dictCategories: Dictionary - -dictAllMaterials: Dictionary - -rootCategories: Collection - +LoadData(wsConfig, wsPlatform) - +GetRootCategories() Collection - +GetCategory(categoryName) clsCategory - } - - class clsCategory { - +categoryName: String - +ParentCategoryName: String - +materials: Collection - +SubCategories: Collection - +AddMaterial(mat) - +AddSubCategory(cat) - +HasSubCategories: Boolean - } - - class clsMaterialItem { - +code: String - +Name: String - +Quantity: Double - +Condition: String - +Category: String - +ParentCategory: String - } - - clsBOMManager "1" --> "*" clsCategory : 管理 - clsCategory "1" --> "*" clsMaterialItem : 包含 - clsCategory "1" --> "*" clsCategory : 父子关系 -``` - -### 三个核心数据容器 - -| 数据容器 | 类型 | 键/索引 | 值 | 用途 | -|---------|------|---------|-----|------| -| `dictAllMaterials` | Dictionary | 物料代号 (String) | clsMaterialItem | 快速查找任意物料的完整信息 | -| `dictCategories` | Dictionary | 类别名称 (String) | clsCategory | 快速查找任意类别 | -| `rootCategories` | Collection | 索引 (Long) | clsCategory | 遍历完整的类别树结构 | - ---- - -## 流程时序图 - -```mermaid -sequenceDiagram - participant Caller as 调用者 - participant LoadData as LoadData方法 - participant WSPlatform as [平台配置清单] - participant WSConfig as [领料配置] - participant DictMat as dictAllMaterials - participant DictCat as dictCategories - participant RootCats as rootCategories - - Caller->>LoadData: LoadData(wsConfig, wsPlatform) - - Note over LoadData, WSPlatform: 第一步: 加载物料库 - LoadData->>WSPlatform: 读取第4-末行, C-F列 - WSPlatform-->>LoadData: 返回物料数据 - loop 每一行物料 - LoadData->>DictMat: 添加物料 (代号→对象) - end - - Note over LoadData, WSConfig: 第二步: 建立类别与物料关联 - LoadData->>WSConfig: 读取第2-末行, A/C/D列 - WSConfig-->>LoadData: 返回类别配置 - loop 每一行配置 - LoadData->>DictCat: 类别存在? - alt 类别不存在 - LoadData->>DictCat: 创建新类别 - end - LoadData->>DictMat: 查找物料信息 - alt 物料存在 - LoadData->>DictCat: 添加物料到类别 - end - end - - Note over LoadData, RootCats: 第三步: 构建层级树 - loop 遍历所有类别 - LoadData->>DictCat: 获取类别 - alt 有父类别 - LoadData->>DictCat: 添加到父类别的SubCategories - else 无父类别 - LoadData->>RootCats: 添加为根类别 - end - end - - LoadData-->>Caller: 完成 -``` - ---- - -## 重要业务规则 - -### 1. 物料筛选规则 -- ✅ 在 [领料配置] 中的物料 → **需要领料**，会被添加到类别中 -- ❌ 不在 [领料配置] 中的物料 → **不需要领料**，仅在 `dictAllMaterials` 中 - -### 2. 类别层级规则 -- 根类别：`ParentCategoryName` 为空字符串 `""` -- 子类别：`ParentCategoryName` 指向父类别名称 -- 层级深度：无限制（支持任意深度的树形结构） - -### 3. 数据一致性 -- 所有物料必须先在 [平台配置清单] 中定义 -- [领料配置] 中的物料代号必须在 `dictAllMaterials` 中存在 -- 如果不存在，该物料会被跳过（不会报错） - ---- - -## 使用示例 - -### 调用 LoadData - -```vba -Dim bomMgr As New clsBOMManager -Dim wsConfig As Worksheet -Dim wsPlatform As Worksheet - -Set wsConfig = ThisWorkbook.Worksheets("领料配置") -Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单") - -' 加载数据 -Call bomMgr.LoadData(wsConfig, wsPlatform) - -' 获取根类别 -Dim rootCats As Collection -Set rootCats = bomMgr.GetRootCategories() - -' 遍历所有根类别 -Dim i As Long -For i = 1 To rootCats.Count - Debug.Print "根类别: " & rootCats(i).categoryName -Next i -``` - ---- - -## 执行后的数据结构示例 - -假设加载后的数据结构如下： - -``` -dictAllMaterials: -{ - "01091004312" → {code: "01091004312", Name: "表壳(本色)", Quantity: 1, Condition: ""}, - "01011019001" → {code: "01011019001", Name: "低压接头部件", Quantity: 1, Condition: "lcfw=M02"}, - "01081013833" → {code: "01081013833", Name: "径向低压接头", Quantity: 1, Condition: "gclj=Z12"} -} - -dictCategories: -{ - "表壳" → {categoryName: "表壳", ParentCategoryName: "", materials: [01091004312], SubCategories: []}, - "部件" → {categoryName: "部件", ParentCategoryName: "", materials: [01011019001], SubCategories: ["接头", "弹性元件"]}, - "接头" → {categoryName: "接头", ParentCategoryName: "部件", materials: [01081013833], SubCategories: []} -} - -rootCategories: -[ - "表壳" (clsCategory), - "部件" (clsCategory), - "机芯" (clsCategory) -] -``` - ---- - -## 错误处理 - -LoadData 方法本身不包含显式的错误处理（`On Error`），依赖以下机制： - -1. **空值处理**：使用 `& ""` 确保字符串转换不会失败 -2. **类型转换**：使用 `CDbl()` 时没有错误处理，假设数据格式正确 -3. **跳过机制**：物料代号为空时，使用 `GoTo NextRow` 跳过 -4. **存在性检查**：使用 `Dictionary.Exists()` 避免键不存在错误 - ---- - -## 相关方法 - -LoadData 执行后，可以使用以下方法访问数据： - -| 方法 | 说明 | -|------|------| -| `GetRootCategories()` | 获取所有顶层类别 | -| `GetCategory(categoryName)` | 根据名称获取类别对象 | -| `GetMaterialsByModel()` | 根据型号获取物料 | -| `GetValidMaterialsByModel()` | 获取物料并检查完整性 | -| `PrintCategoryTree()` | 打印类别树（调试用） | - ---- - -## 总结 - -`LoadData` 方法通过三个阶段构建完整的 BOM 数据结构： - -1. **数据收集**：从 [平台配置清单] 收集所有物料基础信息 -2. **数据关联**：从 [领料配置] 建立类别与物料的关联 -3. **结构构建**：构建类别的树形层级关系 - -最终形成的数据结构支持： -- 快速按代号查找物料 -- 快速按类别查找物料 -- 遍历完整的类别树 -- 支持父类别/子类别的领料逻辑 diff --git a/reference_docs/clsBOMManager使用说明.md b/reference_docs/clsBOMManager使用说明.md deleted file mode 100644 index 6d7038f..0000000 --- a/reference_docs/clsBOMManager使用说明.md +++ /dev/null @@ -1,545 +0,0 @@ -# clsBOMManager 类使用说明 - -## 概述 - -`clsBOMManager` 是 AutoBOM 系统的核心控制器类，负责管理整个 BOM（物料清单）数据结构。它从 Excel 工作表加载数据，构建层级化的类别树，并提供物料查询和领料逻辑处理功能。 - ---- - -## 类初始化 - -```vba -Dim bomMgr As New clsBOMManager -``` - -创建实例时，会自动初始化以下内部数据结构： -- `dictCategories` - 类别字典（类别名称 → clsCategory 对象） -- `dictAllMaterials` - 物料字典（物料代号 → clsMaterialItem 对象） -- `rootCategories` - 根类别集合（顶层类别） - ---- - -## 公开方法 - -### 1. LoadData 方法 - -**功能**：从 Excel 工作表加载 BOM 数据并构建数据结构 - -**语法**： -```vba -Public Sub LoadData(wsConfig As Worksheet, wsPlatform As Worksheet) -``` - -**参数**： -| 参数 | 类型 | 说明 | -|------|------|------| -| wsConfig | Worksheet | 领料配置工作表，定义类别层级和需要领料的物料 | -| wsPlatform | Worksheet | 平台配置清单工作表，包含完整的物料信息 | - -**数据要求**： - -**领料配置** 工作表格式： -- **第 1 行**：标题行 -- **第 2 行起**：数据行 - - A 列：物料代号 - - C 列：类别名称 - - D 列：上层类别名称 - -**平台配置清单** 工作表格式： -- **第 1-3 行**：标题行 -- **第 4 行起**：数据行 - - C 列：物料代号 - - D 列：物料名称 - - E 列：物料数量 - - F 列：选择条件 - -**处理逻辑**： -1. 从"平台配置清单"加载所有物料的基础信息到 `dictAllMaterials` -2. 从"领料配置"加载类别信息，筛选需要领料的物料 -3. 建立类别的父子关系，构建层级树 - -**重要说明**： -- 只有出现在"领料配置"中的物料才会被添加到类别中 -- 未在"领料配置"中的物料表示不需要领料，但仍存在于物料字典中 - -**使用示例**： -```vba -Dim bomMgr As New clsBOMManager -Dim wsConfig As Worksheet -Dim wsPlatform As Worksheet - -Set wsConfig = ThisWorkbook.Worksheets("领料配置") -Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单") - -bomMgr.LoadData wsConfig, wsPlatform -``` - ---- - -### 2. GetRootCategories 方法 - -**功能**：获取所有顶层类别的集合 - -**语法**： -```vba -Public Function GetRootCategories() As Collection -``` - -**返回值**： -- `Collection` 对象，包含所有无父类别的 `clsCategory` 对象 - -**用途**： -- 遍历整个 BOM 结构时的入口点 -- 生成领料清单时遍历所有根类别 - -**使用示例**： -```vba -Dim rootCats As Collection -Dim cat As clsCategory -Dim i As Long - -Set rootCats = bomMgr.GetRootCategories() - -For i = 1 To rootCats.Count - Set cat = rootCats(i) - Debug.Print "根类别: " & cat.categoryName - Debug.Print " 物料数: " & cat.Materials.Count - Debug.Print " 子类别数: " & cat.SubCategories.Count -Next i -``` - ---- - -### 3. GetCategory 方法 - -**功能**：根据类别名称获取类别对象 - -**语法**： -```vba -Public Function GetCategory(categoryName As String) As clsCategory -``` - -**参数**： -| 参数 | 类型 | 说明 | -|------|------|------| -| categoryName | String | 要查询的类别名称 | - -**返回值**： -- 找到时：返回 `clsCategory` 对象 -- 未找到时：返回 `Nothing` - -**用途**：快速查找特定类别及其下的物料 - -**使用示例**： -```vba -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.IsLeafCategory -End If -``` - ---- - -### 4. GetMaterialsForPicking 方法 - -**功能**：获取某类别下需要领料的物料清单（支持层级逻辑） - -**语法**： -```vba -Public Function GetMaterialsForPicking(categoryName As String, _ - Optional useParent As Boolean = True) As Collection -``` - -**参数**： -| 参数 | 类型 | 默认值 | 说明 | -|------|------|--------|------| -| categoryName | String | - | 类别名称 | -| useParent | Boolean | True | 领料方式：True=父类别物料，False=子类别物料 | - -**返回值**： -- `Collection` 对象，包含 `clsMaterialItem` 对象 - -**业务逻辑说明**： - -#### 父类别模式 (useParent=True) -- 这是**默认的领料方式** -- 直接返回当前类别下的所有物料 -- 即使该类别有子类别，也仍然返回父类别物料 -- 用于领取组装好的部件 - -**示例**： -```vba -' 获取"部件"类别的父类别物料 -Set materials = bomMgr.GetMaterialsForPicking("部件", True) -' 返回：低压接头部件、高压接头部件等组装好的部件 -``` - -#### 子类别模式 (useParent=False) -- 这是**库存不足时的替代方案** -- 如果当前类别有子类别，递归获取所有子类别的物料 -- 如果当前类别是叶子类别（无子类别），返回本类别物料 -- 用于父类别库存不足，需要领取零件自行组装的情况 - -**示例**： -```vba -' 获取"部件"类别的子类别展开物料 -Set materials = bomMgr.GetMaterialsForPicking("部件", False) -' 返回：径向低压接头、弹簧管、螺旋管等零件 -``` - -**层级结构示例**： - -``` -部件 (父类别) -├── 低压接头部件 (物料) -├── 高压接头部件 (物料) -└── 接头 (子类别) - ├── 径向低压接头 (物料) - ├── 轴向高压接头 (物料) - └── 弹性元件 (孙类别) - └── 弹簧管 (物料) -``` - -**使用示例**： -```vba -Dim materials As Collection -Dim mat As clsMaterialItem -Dim i As Long - -' 默认使用父类别物料 -Set materials = bomMgr.GetMaterialsForPicking("部件", True) -Debug.Print "父类别物料数: " & materials.Count - -For i = 1 To materials.Count - Set mat = materials(i) - Debug.Print mat.code & " - " & mat.Name & _ - " | 数量:" & mat.Quantity & _ - " | 条件:" & mat.Condition -Next i - -' 库存不足时，使用子类别物料 -Set materials = bomMgr.GetMaterialsForPicking("部件", False) -Debug.Print "子类别展开物料数: " & materials.Count -``` - ---- - -### 5. PrintCategoryTree 方法 - -**功能**：将类别树结构打印到工作表（用于调试和查看） - -**语法**： -```vba -Public Sub PrintCategoryTree(ws As Worksheet) -``` - -**参数**： -| 参数 | 类型 | 说明 | -|------|------|------| -| ws | Worksheet | 输出的目标工作表对象 | - -**输出格式**： -- 第 1 列：类别名称（带缩进显示层级） -- 第 2 列：物料数量信息 -- 第 3 列：选择条件 - -**缩进规则**：每层级 2 个空格 - -**输出示例**： -``` -表壳 (物料数:1) - - 01091004312 表壳(本色) 数量:1 条件: -部件 (物料数:20) - - 01011019001 低压接头部件 数量:1 条件:lcfw=M02... - 接头 (物料数:18) - - 01081013833 径向低压接头 数量:1 条件:gclj=Z12... -``` - -**使用示例**： -```vba -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 -``` - ---- - -## 典型使用场景 - -### 场景 1：生成领料清单 - -```vba -Sub GeneratePickingList() - Dim bomMgr As New clsBOMManager - Dim wsConfig As Worksheet, wsPlatform As Worksheet - Dim wsPickList As Worksheet - Dim rootCats As Collection - Dim cat As clsCategory - Dim materials As Collection - Dim mat As clsMaterialItem - Dim row As Long - Dim i As Long, j As Long - - ' 1. 加载数据 - Set wsConfig = ThisWorkbook.Worksheets("领料配置") - Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单") - bomMgr.LoadData wsConfig, wsPlatform - - ' 2. 创建输出工作表 - Application.DisplayAlerts = False - On Error Resume Next - ThisWorkbook.Worksheets("领料清单").Delete - On Error GoTo 0 - Application.DisplayAlerts = True - - Set wsPickList = ThisWorkbook.Worksheets.Add - wsPickList.Name = "领料清单" - - ' 3. 写入表头 - 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 - - ' 4. 遍历所有根类别并生成清单 - Set rootCats = bomMgr.GetRootCategories - - 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 - - ' 5. 格式化表格 - wsPickList.Range("A1:F1").Font.Bold = True - wsPickList.Columns("A:F").AutoFit - - MsgBox "领料清单生成完成!", vbInformation -End Sub -``` - -### 场景 2：查询特定类别信息 - -```vba -Sub QueryCategoryInfo() - Dim bomMgr As New clsBOMManager - Dim wsConfig As Worksheet, wsPlatform As Worksheet - Dim cat As clsCategory - Dim mat As clsMaterialItem - Dim subCat As clsCategory - Dim i As Long - - ' 加载数据 - Set wsConfig = ThisWorkbook.Worksheets("领料配置") - Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单") - bomMgr.LoadData wsConfig, wsPlatform - - ' 查询特定类别 - Set cat = bomMgr.GetCategory("部件") - - If Not cat Is Nothing Then - Debug.Print "========== 类别信息 ==========" - Debug.Print "类别名称: " & cat.categoryName - Debug.Print "父类别: " & cat.ParentCategoryName - Debug.Print "物料数量: " & cat.Materials.Count - Debug.Print "子类别数量: " & cat.SubCategories.Count - Debug.Print "是否叶子类别: " & cat.IsLeafCategory - Debug.Print "" - - ' 列出所有物料 - Debug.Print "---------- 物料列表 ----------" - For i = 1 To cat.Materials.Count - Set mat = cat.Materials(i) - Debug.Print " " & mat.code & ": " & mat.Name & _ - " (数量:" & mat.Quantity & _ - ", 条件:" & mat.Condition & ")" - Next i - Debug.Print "" - - ' 列出所有子类别 - Debug.Print "---------- 子类别列表 ----------" - For i = 1 To cat.SubCategories.Count - Set subCat = cat.SubCategories(i) - Debug.Print " " & subCat.categoryName & _ - " (物料数:" & subCat.Materials.Count & ")" - Next i - Else - Debug.Print "类别不存在" - End If -End Sub -``` - -### 场景 3：根据库存情况选择领料方式 - -```vba -Sub SmartPicking() - Dim bomMgr As New clsBOMManager - Dim materials As Collection - Dim mat As clsMaterialItem - Dim categoryName As String - Dim i As Long - - ' 加载数据 - bomMgr.LoadData _ - ThisWorkbook.Worksheets("领料配置"), _ - ThisWorkbook.Worksheets("平台配置清单") - - categoryName = "部件" - - ' 尝试获取父类别物料 - Set materials = bomMgr.GetMaterialsForPicking(categoryName, True) - - ' 检查库存是否充足（这里需要连接实际的库存系统） - Dim isStockSufficient As Boolean - isStockSufficient = CheckStock(materials) ' 假设的库存检查函数 - - If isStockSufficient Then - Debug.Print "使用父类别领料方式" - Else - Debug.Print "父类别库存不足，改用子类别领料方式" - Set materials = bomMgr.GetMaterialsForPicking(categoryName, False) - End If - - ' 输出物料清单 - For i = 1 To materials.Count - Set mat = materials(i) - Debug.Print mat.code & " " & mat.Name - Next i -End Sub -``` - ---- - -## 辅助类说明 - -### clsCategory 类 - -表示物料类别及其层级关系。 - -**公共属性**： -| 属性 | 类型 | 说明 | -|------|------|------| -| categoryName | String | 类别名称 | -| ParentCategoryName | String | 父类别名称 | -| Materials | Collection | 该类别下的物料集合 | -| SubCategories | Collection | 子类别集合 | -| IsLeafCategory | Boolean | 是否为叶子类别（无子类别） | - -**公共方法**： -- `AddMaterial(mat As clsMaterialItem)` - 添加物料 -- `AddSubCategory(cat As clsCategory)` - 添加子类别 -- `GetMaterial(code As String) As clsMaterialItem` - 获取指定代号的物料 -- `HasSubCategories() As Boolean` - 检查是否有子类别 - -### clsMaterialItem 类 - -表示单个物料项。 - -**公共属性**： -| 属性 | 类型 | 说明 | -|------|------|------| -| code | String | 物料代号 | -| Name | String | 物料名称 | -| Quantity | Double | 物料数量 | -| Condition | String | 选择条件 | -| Category | String | 所属类别 | -| ParentCategory | String | 上层类别 | - ---- - -## 注意事项 - -1. **数据加载顺序**：必须先调用 `LoadData()` 方法，才能使用其他查询方法 - -2. **工作表名称**：确保工作表名称与代码中的名称一致： - - "领料配置" - - "平台配置清单" - -3. **空值处理**：使用 `GetCategory()` 方法时，务必检查返回值是否为 `Nothing` - -4. **领料方式选择**： - - 正常情况使用 `useParent=True`（领取组装好的部件） - - 仅在库存不足时使用 `useParent=False`（领取零件自行组装） - -5. **数据一致性**：修改 Excel 数据后，需要重新调用 `LoadData()` 重新加载数据 - -6. **内存管理**：使用完毕后，VBA 会自动清理对象，无需手动释放 - ---- - -## 常见问题 - -### Q1: 如何判断某个类别是否存在？ -```vba -Dim cat As clsCategory -Set cat = bomMgr.GetCategory("类别名") - -If Not cat Is Nothing Then - ' 类别存在 -Else - ' 类别不存在 -End If -``` - -### Q2: 如何获取所有类别的名称？ -```vba -Sub ListAllCategories() - ' 需要递归遍历所有类别 - ' 可以使用 PrintCategoryTree 方法输出到工作表查看 -End Sub -``` - -### Q3: 父类别和子类别物料有什么区别？ -- **父类别物料**：组装好的成品部件，如"低压接头部件" -- **子类别物料**：组成部件的零件，如"径向低压接头"、"弹簧管"等 - -### Q4: 如何处理物料选择条件？ -```vba -Dim mat As clsMaterialItem -' ... -If mat.Condition <> "" Then - ' 根据条件选择合适的物料 - ' 条件格式如：lcfw=M02;gclj=Z12 - ' 需要根据产品配置解析这些条件 -End If -``` - ---- - -## 版本信息 - -- **类名称**：clsBOMManager -- **版本**：1.0 -- **最后更新**：2025 -- **依赖类**：clsCategory, clsMaterialItem diff --git a/reference_docs/combined_output.md b/reference_docs/combined_output.md deleted file mode 100644 index f095227..0000000 --- a/reference_docs/combined_output.md +++ /dev/null @@ -1,2876 +0,0 @@ -# 目录 - -- [ClassModules\clsBOMManager.cls](#classmodules-clsbommanager-cls) -- [ClassModules\clsCategory.cls](#classmodules-clscategory-cls) -- [ClassModules\clsConditionExtractor.cls](#classmodules-clsconditionextractor-cls) -- [ClassModules\clsConditionMatcher.cls](#classmodules-clsconditionmatcher-cls) -- [ClassModules\clsMaterialItem.cls](#classmodules-clsmaterialitem-cls) -- [ClassModules\clsModelParser.cls](#classmodules-clsmodelparser-cls) -- [Modules\modBOMProcessor.bas](#modules-modbomprocessor-bas) -- [Modules\modModelParserExamples.bas](#modules-modmodelparserexamples-bas) -- [Modules\modModelParserTest.bas](#modules-modmodelparsertest-bas) - ---- - -## ClassModules\clsBOMManager.cls - -``` -' ======================================== -' 类模块: clsBOMManager -' 用途: 管理整个BOM数据结构 -' 功能: -' 1. 加载和组织BOM数据 -' 2. 建立类别层级关系 -' 3. 提供物料查询接口 -' 4. 支持领料逻辑处理 -' ======================================== -Option Explicit - -' ======================================== -' 私有成员变量 -' ======================================== -Private dictCategories As Object ' Dictionary对象: 类别名称 -> clsCategory对象 - ' 作用: 快速查找任意类别 -Private dictAllMaterials As Object ' Dictionary对象: 物料代号 -> clsMaterialItem对象 - ' 作用: 快速查找任意物料 -Private rootCategories As collection ' Collection: 存储所有顶层类别(无父类别的类别) - ' 作用: 遍历完整的类别树结构 - -' ======================================== -' 类初始化 -' 说明: 创建BOMManager实例时自动调用 -' ======================================== -Private Sub Class_Initialize() - Set dictCategories = CreateObject("Scripting.Dictionary") - Set dictAllMaterials = CreateObject("Scripting.Dictionary") - Set rootCategories = New collection -End Sub - -' ======================================== -' LoadData 方法 -' 功能: 从Excel工作表加载BOM数据并构建数据结构 -' 参数: -' wsConfig - [领料配置]工作表对象,包含类别层级和需要领料的物料 -' wsPlatform - [平台配置清单]工作表对象,包含完整的物料信息(代号/名称/数量/条件) -' 处理步骤: -' 1. 从[平台配置清单]加载所有物料的基础信息到dictAllMaterials -' 2. 从[领料配置]加载类别信息,筛选需要领料的物料 -' 3. 建立类别的父子关系,构建层级树 -' 注意: -' - 只有出现在[领料配置]中的物料才会被添加到类别中 -' - 未在[领料配置]中的物料表示不需要领料 -' ======================================== -Public Sub LoadData(wsConfig As Worksheet, wsPlatform As Worksheet) - Dim i As Long, lastRow As Long - Dim mat As clsMaterialItem - Dim cat As clsCategory - - ' ======================================== - ' 第一步: 从平台配置清单加载所有物料的基础信息 - ' 说明: - ' - 读取C列(代号)、D列(名称)、E列(数量)、F列(选择条件) - ' - 从第4行开始读取(前3行是标题) - ' - 所有物料存入dictAllMaterials字典,以代号为键 - ' 目的: 建立完整的物料信息库,供后续按代号查询 - ' ======================================== - lastRow = wsPlatform.Cells(wsPlatform.Rows.Count, "C").End(xlUp).row - For i = 4 To lastRow ' 从第4行开始(跳过标题) - Set mat = New clsMaterialItem - mat.code = Trim(wsPlatform.Cells(i, "C").value & "") ' 物料代号 - mat.Name = Trim(wsPlatform.Cells(i, "D").value & "") ' 物料名称 - On Error Resume Next - mat.Quantity = CDbl(wsPlatform.Cells(i, "E").value) ' 物料数量 - On Error GoTo 0 - mat.Condition = Trim(wsPlatform.Cells(i, "F").value & "") ' 选择条件 - - ' 只保存代号非空的物料 - If mat.code <> "" Then - Set dictAllMaterials(mat.code) = mat - End If - Next i - - ' ======================================== - ' 第二步: 从领料配置加载类别信息并建立层级 - ' 说明: - ' - 读取A列(代号)、C列(类别)、D列(上层类别) - ' - 从第2行开始读取(第1行是标题) - ' - 只有出现在此表中的物料才需要领料 - ' 处理逻辑: - ' 1. 为每个类别创建clsCategory对象 - ' 2. 从dictAllMaterials中查找对应的物料信息 - ' 3. 将物料添加到对应的类别中 - ' ======================================== - lastRow = wsConfig.Cells(wsConfig.Rows.Count, "A").End(xlUp).row - For i = 2 To lastRow ' 从第2行开始 - Dim code As String, catName As String, parentCatName As String - code = Trim(wsConfig.Cells(i, "A").value & "") ' 物料代号 - catName = Trim(wsConfig.Cells(i, "C").value & "") ' 类别名称 - parentCatName = Trim(wsConfig.Cells(i, "D").value & "") ' 上层类别名称 - - ' 跳过空行 - If code = "" Then GoTo NextRow - - ' 确保类别对象存在(如果类别不存在则创建) - If Not dictCategories.Exists(catName) Then - Set cat = New clsCategory - cat.categoryName = catName - cat.ParentCategoryName = parentCatName - Set dictCategories(catName) = cat - End If - - ' 将物料添加到类别 - ' 注意: 必须先在dictAllMaterials中查找到完整的物料信息 - If dictAllMaterials.Exists(code) Then - Set mat = dictAllMaterials(code) - mat.Category = catName ' 设置物料所属类别 - mat.ParentCategory = parentCatName ' 设置物料的上层类别 - dictCategories(catName).AddMaterial mat ' 将物料添加到类别对象中 - End If - -NextRow: - Next i - - ' ======================================== - ' 第三步: 建立类别层级关系 - ' 说明: - ' - 遍历所有类别,根据ParentCategoryName建立父子关系 - ' - 如果类别有父类别,将自己添加到父类别的SubCategories中 - ' - 如果类别没有父类别,则为根类别,添加到rootCategories中 - ' 结果: - ' - 构建完整的树形结构 - ' - rootCategories包含所有顶层类别 - ' - 每个类别的SubCategories包含其直接子类别 - ' ======================================== - Dim key As Variant - For Each key In dictCategories.Keys - Set cat = dictCategories(key) - If cat.ParentCategoryName <> "" Then - ' 有父类别,建立父子关系 - If dictCategories.Exists(cat.ParentCategoryName) Then - Dim parentCat As clsCategory - Set parentCat = dictCategories(cat.ParentCategoryName) - parentCat.AddSubCategory cat ' 将当前类别添加为父类别的子类别 - End If - Else - ' 无父类别,是根类别 - rootCategories.Add cat, cat.categoryName - End If - Next key -End Sub - -' ======================================== -' GetRootCategories 方法 -' 功能: 获取所有顶层类别的集合 -' 返回: Collection对象,包含所有无父类别的clsCategory对象 -' 用途: -' - 遍历整个BOM结构时的入口点 -' - 生成领料清单时遍历所有根类别 -' 示例: -' Dim cats As Collection -' Set cats = bomMgr.GetRootCategories() -' For i = 1 To cats.Count -' Debug.Print cats(i).CategoryName -' Next i -' ======================================== -Public Function GetRootCategories() As collection - Set GetRootCategories = rootCategories -End Function - -' ======================================== -' GetCategory 方法 -' 功能: 根据类别名称获取类别对象 -' 参数: -' categoryName - 要查询的类别名称(字符串) -' 返回: -' clsCategory对象 - 如果找到 -' Nothing - 如果未找到 -' 用途: 快速查找特定类别及其下的物料 -' 示例: -' Dim cat As clsCategory -' Set cat = bomMgr.GetCategory("部件") -' If Not cat Is Nothing Then -' Debug.Print cat.Materials.Count & " 个物料" -' End If -' ======================================== -Public Function GetCategory(categoryName As String) As clsCategory - If dictCategories.Exists(categoryName) Then - Set GetCategory = dictCategories(categoryName) - Else - Set GetCategory = Nothing - End If -End Function - -' ======================================== -' GetMaterialsForPicking 方法 -' 功能: 获取某类别下需要领料的物料清单(考虑层级逻辑) -' 参数: -' categoryName - 类别名称 -' useParent - 可选参数,默认True -' True: 使用父类别物料(默认领料方式) -' False: 使用子类别物料(库存不足时的替代方案) -' 返回: Collection对象,包含clsMaterialItem对象 -' -' 业务逻辑说明: -' 1. 默认领取父类别的物料(如"低压接头部件") -' 2. 当父类别库存不足时,才领取子类别的物料(如"接头"+"弹性元件") -' 3. 如果useParent=True但类别有子类别,仍返回父类别物料 -' 4. 如果useParent=False,递归获取所有子类别的物料 -' -' 示例1: 获取"部件"类别的物料(父类别) -' Set mats = bomMgr.GetMaterialsForPicking("部件", True) -' ' 返回: 低压接头部件、高压接头部件等组装好的部件 -' -' 示例2: 获取"部件"类别的物料(子类别展开) -' Set mats = bomMgr.GetMaterialsForPicking("部件", False) -' ' 返回: 径向低压接头、弹簧管、螺旋管等零件 -' ======================================== -Public Function GetMaterialsForPicking(categoryName As String, _ - Optional useParent As Boolean = True) As collection - Dim result As collection - Set result = New collection - - ' 查找指定类别 - Dim cat As clsCategory - Set cat = GetCategory(categoryName) - If cat Is Nothing Then - ' 类别不存在,返回空集合 - Set GetMaterialsForPicking = result - Exit Function - End If - - Dim i As Long - - If useParent Then - ' ======================================== - ' 使用父类别物料(默认领料方式) - ' 说明: - ' - 直接返回当前类别下的所有物料 - ' - 即使该类别有子类别,也仍然返回父类别物料 - ' - 这是正常情况下的领料方式(领取组装好的部件) - ' ======================================== - Dim m As clsMaterialItem - For i = 1 To cat.materials.Count - Set m = cat.materials(i) - result.Add m - Next i - Else - ' ======================================== - ' 使用子类别物料(库存不足时的替代方案) - ' 说明: - ' - 如果当前类别有子类别,递归获取所有子类别的物料 - ' - 如果当前类别是叶子类别(无子类别),返回本类别物料 - ' - 这用于父类别库存不足,需要领取零件自行组装的情况 - ' 示例: - ' 当"低压接头部件"库存不足时 - ' 改为领取"径向低压接头"+"弹簧管"零件 - ' ======================================== - If cat.HasSubCategories Then - ' 有子类别,递归获取所有子类别的物料 - Dim subCat As clsCategory - Dim j As Long - For j = 1 To cat.SubCategories.Count - Set subCat = cat.SubCategories(j) - Dim subMats As collection - ' 递归调用,继续展开子类别 - Set subMats = GetMaterialsForPicking(subCat.categoryName, False) - Dim k As Long - For k = 1 To subMats.Count - result.Add subMats(k) - Next k - Next j - Else - ' 叶子类别,返回本类别物料 - For i = 1 To cat.materials.Count - Set m = cat.materials(i) - result.Add m - Next i - End If - End If - - Set GetMaterialsForPicking = result -End Function - -' ======================================== -' PrintCategoryTree 方法 -' 功能: 将类别树结构打印到工作表(用于调试和查看) -' 参数: -' ws - 输出的目标工作表对象 -' 输出格式: -' - 第一列: 类别名称(带缩进显示层级) -' - 第二列: 物料数量信息 -' - 第三列: 选择条件 -' 说明: -' - 使用缩进显示类别层级(每层2个空格) -' - 递归打印所有子类别和物料 -' - 便于验证数据结构是否正确 -' 示例输出: -' 表壳 (物料数:1) -' - 01091004312 表壳(本色) 数量:1 条件: -' 部件 (物料数:20) -' - 01011019001 低压接头部件 数量:1 条件:lcfw=M02... -' 接头 (物料数:18) -' - 01081013833 径向低压接头 数量:1 条件:gclj=Z12... -' ======================================== -Public Sub PrintCategoryTree(ws As Worksheet) - Dim row As Long - row = 1 - ws.Cells(row, 1).value = "类别层级结构" - row = row + 1 - - ' 遍历所有根类别,递归打印整个树 - Dim rootCat As clsCategory - Dim i As Long - For i = 1 To rootCategories.Count - Set rootCat = rootCategories(i) - Call PrintCategory(ws, rootCat, row, 0) - Next i -End Sub - -' ======================================== -' PrintCategory 方法 (私有方法) -' 功能: 递归打印单个类别及其子类别(供PrintCategoryTree调用) -' 参数: -' ws - 输出的工作表对象 -' cat - 要打印的类别对象 -' row - 当前输出行号(ByRef,会被修改) -' level - 当前层级深度(0=根类别,1=一级子类别...) -' 说明: -' - 使用递归方式遍历整个类别树 -' - 根据level参数计算缩进空格数 -' - 先打印类别名,再打印该类别的所有物料,最后递归打印子类别 -' ======================================== -Private Sub PrintCategory(ws As Worksheet, cat As clsCategory, _ - ByRef row As Long, level As Integer) - ' 计算缩进(每层2个空格) - Dim indent As String - indent = String(level * 2, " ") - - ' 打印类别名称和物料数量统计 - ws.Cells(row, 1).value = indent & cat.categoryName & _ - " (物料数:" & cat.materials.Count & ")" - row = row + 1 - - ' 打印该类别下的所有物料 - Dim mat As clsMaterialItem - Dim i As Long - For i = 1 To cat.materials.Count - Set mat = cat.materials(i) - ' 物料行额外缩进2个空格,并加上"- "前缀 - ws.Cells(row, 1).value = indent & " - " & mat.code & " " & mat.Name - ws.Cells(row, 2).value = "数量:" & mat.Quantity - ws.Cells(row, 3).value = "条件:" & mat.Condition - row = row + 1 - Next i - - ' 递归打印所有子类别 - Dim subCat As clsCategory - Dim j As Long - For j = 1 To cat.SubCategories.Count - Set subCat = cat.SubCategories(j) - ' 递归调用,层级加1 - Call PrintCategory(ws, subCat, row, level + 1) - Next j -End Sub -' ======================================== -' GetMaterialsByModel 方法 -' -' 【功能概述】 -' 根据产品型号字符串自动解析规格参数,并返回符合这些规格的所有物料清单。 -' 这是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 - -' ======================================== -' 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值,指示物料是否完整 -' -' 完整性判断规则: -' - 对于每个需要领料的类别(顶层类别或其需要领取的子类别) -' - 必须有且仅有一个物料被匹配 -' - 如果某个类别有0个或多于1个物料,则视为不完整 -' -' 示例: -' Dim result As Collection -' Set result = bomMgr.GetValidMaterialsByModel("YTHN-100.A0.532.M203.M16.Y3") -' Dim materials As Collection -' Dim isComplete As Boolean -' Set materials = result("Materials") -' isComplete = result("IsComplete") -' ======================================== -Public Function GetValidMaterialsByModel(modelStr As String) As collection - Dim result As New collection - Dim allMaterials 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" - Set GetValidMaterialsByModel = result - Exit Function - End If - - Dim extractor As New clsConditionExtractor - Dim conditions As Object - Set conditions = extractor.ExtractConditions(parser) - - ' 调试输出 - Debug.Print "【GetValidMaterialsByModel】" - Debug.Print "型号: " & modelStr - Debug.Print "提取的条件:" - Dim key As Variant - For Each key In conditions.Keys - Debug.Print " " & key & " = " & conditions(key) - Next key - Debug.Print "" - - ' 条件匹配器 - Dim matcher As New clsConditionMatcher - - ' 遍历所有根类别,检查完整性 - isComplete = True - Dim categoryCheckResults As Object - Set categoryCheckResults = CreateObject("Scripting.Dictionary") - - Dim rootCat As clsCategory - Dim i As Long - For i = 1 To rootCategories.count - Set rootCat = rootCategories(i) - - ' 检查该类别及其子类别的完整性 - Dim catResult As Object - Set catResult = CheckCategoryCompleteness(rootCat, matcher, conditions) - - ' 合并物料 - Dim mat As clsMaterialItem - Dim matCollection As collection - Set matCollection = catResult("Materials") - For Each mat In matCollection - allMaterials.Add mat - Next mat - - ' 检查完整性 - If Not catResult("IsComplete") Then - isComplete = False - Debug.Print "【不完整】类别 """ & rootCat.categoryName & """ 物料不完整" - End If - - ' 保存类别检查结果(用于调试) - categoryCheckResults(rootCat.categoryName) = catResult("IsComplete") - Next i - - ' 调试输出总结 - Debug.Print "" - Debug.Print "【完整性检查结果】" - Debug.Print "总物料数: " & allMaterials.count - Debug.Print "是否完整: " & IIf(isComplete, "是", "否") - For Each key In categoryCheckResults.Keys - Debug.Print " " & key & ": " & IIf(categoryCheckResults(key), "完整", "不完整") - Next key - Debug.Print String(60, "=") - - ' 返回结果 - result.Add allMaterials, "Materials" - result.Add isComplete, "IsComplete" - Set GetValidMaterialsByModel = result -End Function - -' ======================================== -' CheckCategoryCompleteness 方法 (私有) -' 功能: 检查单个类别的完整性(递归处理子类别) -' 参数: -' cat - 类别对象 -' matcher - 条件匹配器 -' conditions - 提取的条件字典 -' 返回: Dictionary对象 -' "Materials" - Collection,包含该类别匹配的物料 -' "IsComplete" - Boolean,该类别是否完整 -' -' 完整性判断逻辑: -' 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 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: 叶子类别(无子类别) - ' 必须有且仅有1个物料 - ' ======================================== - If matchCount = 1 Then - isComplete = True - Debug.Print "【完整】叶子类别 """ & cat.categoryName & """ 有1个匹配物料" - Else - isComplete = False - If matchCount = 0 Then - Debug.Print "【不完整】叶子类别 """ & cat.categoryName & """ 无匹配物料" - Else - Debug.Print "【不完整】叶子类别 """ & cat.categoryName & """ 有" & matchCount & "个匹配物料(应为1个)" - End If - End If - Else - ' ======================================== - ' 情况2: 有子类别 - ' 先检查父类别,如果父类别满足则使用父类别 - ' 否则降级到子类别,每个子类别都必须满足 - ' ======================================== - If matchCount = 1 Then - ' 父类别有且仅有1个物料,使用父类别 - isComplete = True - Debug.Print "【完整】父类别 """ & cat.categoryName & """ 有1个匹配物料,使用父类别" - ElseIf matchCount = 0 Then - ' 父类别无匹配物料,降级到子类别 - Debug.Print "【降级】父类别 """ & cat.categoryName & """ 无匹配物料,检查子类别..." - - ' 清空物料集合,准备收集子类别物料 - Set materials = New collection - isComplete = True ' 假设完整,如果任一子类别不完整则设为False - - 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) - - ' 合并子类别物料 - Dim subMaterials As collection - Set subMaterials = subResult("Materials") - Dim k As Long - For k = 1 To subMaterials.count - materials.Add subMaterials(k) - Next k - - ' 检查子类别是否完整 - If Not subResult("IsComplete") Then - isComplete = False - End If - Next j - - If isComplete Then - Debug.Print "【完整】类别 """ & cat.categoryName & """ 所有子类别都完整" - Else - Debug.Print "【不完整】类别 """ & cat.categoryName & """ 存在不完整的子类别" - End If - Else - ' 父类别有多个匹配物料,不完整 - isComplete = False - Debug.Print "【不完整】父类别 """ & cat.categoryName & """ 有" & matchCount & "个匹配物料(应为0或1个)" - End If - End If - - ' 返回结果 - Set result("Materials") = materials - result("IsComplete") = isComplete - Set CheckCategoryCompleteness = result -End Function -``` - -## ClassModules\clsCategory.cls - -``` -' ======================================== -' 类模块: 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 ' 是否叶子类别(无子类别) - -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 -``` - -## ClassModules\clsConditionExtractor.cls - -``` -' ======================================== -' 类模块: 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") - - ' 未来可以在这里添加更多提取规则... - ' 例如: - ' 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 -``` - -## ClassModules\clsConditionMatcher.cls - -``` -' ======================================== -' 类模块: 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 -``` - -## ClassModules\clsMaterialItem.cls - -``` -' ======================================== -' 类模块: 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 ' 上层类别 -``` - -## ClassModules\clsModelParser.cls - -``` -' ======================================== -' 类模块: 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 -``` - -## Modules\modBOMProcessor.bas - -``` -' ======================================== -' 模块: modBOMTest -' 用途: 测试和使用BOM数据结构 -' ======================================== -Option Explicit - -Sub TestBOMStructure() - ' 初始化BOM管理器 - Dim bomMgr As New clsBOMManager - - ' 加载数据(假设工作表名称) - Dim wsConfig As Worksheet - Dim wsPlatform As Worksheet - - Set wsConfig = ThisWorkbook.Worksheets("领料配置") - Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单") - - ' 加载数据 - bomMgr.LoadData wsConfig, 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 wsConfig As Worksheet, wsPlatform As Worksheet - - Set wsConfig = ThisWorkbook.Worksheets("领料配置") - Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单") - - bomMgr.LoadData wsConfig, 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 wsConfig As Worksheet, wsPlatform As Worksheet - - Set wsConfig = ThisWorkbook.Worksheets("领料配置") - Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单") - - bomMgr.LoadData wsConfig, 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 wsConfig As Worksheet, wsPlatform As Worksheet - - Set wsConfig = ThisWorkbook.Worksheets("领料配置") - Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单") - - bomMgr.LoadData wsConfig, 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 -``` - -## Modules\modModelParserExamples.bas - -``` -' ======================================== -' 模块: modModelParserExamples -' 用途: 型号解析与物料匹配的实际应用示例 -' ======================================== -Option Explicit - -' ======================================== -' 示例1: 根据型号生成完整的领料清单 -' ======================================== -Sub Example1_GeneratePickingListByModel() - Dim bomMgr As New clsBOMManager - Dim wsConfig As Worksheet - Dim wsPlatform As Worksheet - - ' 加载配置 - Set wsConfig = ThisWorkbook.Worksheets("领料配置") - Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单") - bomMgr.LoadData wsConfig, 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: 批量处理多个型号 -' ======================================== -Sub Example2_BatchProcessModels() - Dim bomMgr As New clsBOMManager - Dim wsConfig As Worksheet - Dim wsPlatform As Worksheet - - ' 加载配置 - Set wsConfig = ThisWorkbook.Worksheets("领料配置") - Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单") - bomMgr.LoadData wsConfig, 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: 验证物料选择条件的有效性 -' ======================================== -Sub Example5_ValidateMaterialConditions() - Dim bomMgr As New clsBOMManager - Dim wsConfig As Worksheet - Dim wsPlatform As Worksheet - - ' 加载配置 - Set wsConfig = ThisWorkbook.Worksheets("领料配置") - Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单") - bomMgr.LoadData wsConfig, 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: 对比启用/禁用自动降级的效果 -' ======================================== -Sub Example6_CompareAutoFallback() - Dim bomMgr As New clsBOMManager - Dim wsConfig As Worksheet - Dim wsPlatform As Worksheet - - ' 加载配置 - Set wsConfig = ThisWorkbook.Worksheets("领料配置") - Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单") - bomMgr.LoadData wsConfig, 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方法 -' ======================================== -Sub Example7_TestGetValidMaterialsByModel() - Dim bomMgr As New clsBOMManager - Dim wsConfig As Worksheet - Dim wsPlatform As Worksheet - - ' 加载配置 - Set wsConfig = ThisWorkbook.Worksheets("领料配置") - Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单") - bomMgr.LoadData wsConfig, 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.M02.Y3|BP-095.2312.M02.PA3", "完整型号测试2"), _ - Array("YTHN-100.A0.532.M203.M12.Y3|BP-095.2312.M12.PA3", "完整型号测试3"), _ - 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) - - ' 调用GetValidMaterialsByModel - Dim result As collection - Set result = bomMgr.GetValidMaterialsByModel(modelStr) - - Dim materials As collection - Dim isComplete As Boolean - Set materials = result("Materials") - isComplete = result("IsComplete") - - ' 写入测试名称和型号 - wsTest.Cells(row, 1).value = "测试 " & (i + 1) & ": " & testName - wsTest.Cells(row, 1).Font.Bold = True - 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 - - wsTest.Cells(row, 1).value = "物料数量:" - wsTest.Cells(row, 2).value = materials.count - row = row + 1 - - ' 写入物料明细表头 - wsTest.Cells(row, 1).value = "类别" - wsTest.Cells(row, 2).value = "代号" - wsTest.Cells(row, 3).value = "名称" - wsTest.Cells(row, 4).value = "数量" - wsTest.Cells(row, 5).value = "选择条件" - wsTest.Range(wsTest.Cells(row, 1), wsTest.Cells(row, 5)).Font.Bold = True - wsTest.Range(wsTest.Cells(row, 1), wsTest.Cells(row, 5)).Interior.Color = RGB(200, 200, 200) - row = row + 1 - - ' 写入每个物料 - Dim mat As clsMaterialItem - Dim j As Long - For j = 1 To materials.count - Set mat = materials(j) - 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 - wsTest.Cells(row, 5).value = IIf(mat.Condition = "", "(无条件)", mat.Condition) - row = row + 1 - Next j - - ' 添加分隔行 - row = row + 1 - wsTest.Cells(row, 1).value = String(80, "-") - row = row + 2 - Next i - - ' 添加统计汇总 - wsTest.Cells(row, 1).value = "测试汇总" - wsTest.Cells(row, 1).Font.Bold = True - wsTest.Cells(row, 1).Font.Size = 12 - row = row + 1 - - Dim completeCount As Long - Dim incompleteCount As Long - completeCount = 0 - incompleteCount = 0 - - For i = LBound(testModels) To UBound(testModels) - modelStr = testModels(i)(0) - Set result = bomMgr.GetValidMaterialsByModel(modelStr) - If result("IsComplete") Then - completeCount = completeCount + 1 - Else - incompleteCount = incompleteCount + 1 - End If - Next i - - wsTest.Cells(row, 1).value = "总测试数:" - wsTest.Cells(row, 2).value = UBound(testModels) - LBound(testModels) + 1 - row = row + 1 - - wsTest.Cells(row, 1).value = "完整:" - wsTest.Cells(row, 2).value = completeCount - wsTest.Cells(row, 2).Font.Color = RGB(0, 128, 0) - row = row + 1 - - wsTest.Cells(row, 1).value = "不完整:" - wsTest.Cells(row, 2).value = incompleteCount - wsTest.Cells(row, 2).Font.Color = RGB(255, 0, 0) - - ' 格式化 - wsTest.Columns("A:E").AutoFit - - MsgBox "物料完整性测试完成！" & vbCrLf & _ - "完整: " & completeCount & " 个" & vbCrLf & _ - "不完整: " & incompleteCount & " 个" & vbCrLf & vbCrLf & _ - "请查看工作表: 物料完整性测试", vbInformation -End Sub -``` - -## Modules\modModelParserTest.bas - -``` -' ======================================== -' 模块: 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 wsConfig As Worksheet - Dim wsPlatform As Worksheet - - On Error Resume Next - Set wsConfig = ThisWorkbook.Worksheets("领料配置") - Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单") - On Error GoTo 0 - - If wsConfig Is Nothing Or wsPlatform Is Nothing Then - Debug.Print "? 错误: 找不到必需的工作表" - Exit Sub - End If - - bomMgr.LoadData wsConfig, 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 wsConfig As Worksheet - Dim wsPlatform As Worksheet - - On Error Resume Next - Set wsConfig = ThisWorkbook.Worksheets("领料配置") - Set wsPlatform = ThisWorkbook.Worksheets("平台配置清单") - On Error GoTo 0 - - If wsConfig Is Nothing Or wsPlatform Is Nothing Then - Debug.Print "? 错误: 找不到必需的工作表" - Exit Sub - End If - - bomMgr.LoadData wsConfig, 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 -``` diff --git a/reference_docs/型号解析与物料匹配系统 - 使用说明.md b/reference_docs/型号解析与物料匹配系统 - 使用说明.md deleted file mode 100644 index 01cc64b..0000000 --- a/reference_docs/型号解析与物料匹配系统 - 使用说明.md +++ /dev/null @@ -1,428 +0,0 @@ -# 型号解析与物料匹配系统 - 使用说明 - -## 📋 目录 - -1. [系统概述](#系统概述) -2. [安装部署](#安装部署) -3. [快速开始](#快速开始) -4. [详细使用](#详细使用) -5. [API参考](#api参考) -6. [扩展指南](#扩展指南) -7. [常见问题](#常见问题) - ---- - -## 系统概述 - -### 功能简介 - -本系统实现了从产品型号中自动提取物料选择条件，并根据这些条件从BOM库中筛选出符合要求的物料清单。 - -### 核心功能 - -- ✅ **型号解析**: 自动解析产品型号的各个组成部分 -- ✅ **条件提取**: 按规则提取物料选择条件(过程连接、接液材质、量程范围等) -- ✅ **条件匹配**: 支持复杂的逻辑表达式(AND/OR/NOT/括号) -- ✅ **物料筛选**: 自动筛选符合条件的物料 -- ✅ **批量处理**: 支持批量处理多个型号 -- ✅ **可扩展性**: 便于添加新的提取条件和匹配规则 - -### 示例 - -**输入型号**: `YTHN-100.A0.532.M203.M16.Y3|BP-095.2312.M16.PA3` - -**提取条件**: -- `gclj` (过程连接) = `M20` -- `jycz` (接液材质) = `3` -- `lcfw` (量程范围) = `M16` - -**匹配结果**: `01011019018 - 高压接头部件` - ---- - -## 安装部署 - -### 1. 导入类模块 - -将以下4个类模块文件导入到VBA项目中: - -1. **clsModelParser.cls** - 型号解析器 -2. **clsConditionExtractor.cls** - 条件提取器 -3. **clsConditionMatcher.cls** - 条件匹配器 -4. **clsBOMManager.cls** - BOM管理器(扩展版本) - -### 2. 导入标准模块 - -将以下2个标准模块导入到VBA项目中: - -1. **modModelParserTest.bas** - 测试模块 -2. **modModelParserExamples.bas** - 应用示例模块 - -### 3. 验证安装 - -运行测试过程验证安装是否成功: - -```vba -' 在立即窗口或通过运行按钮执行 -RunAllTests -``` - -如果所有测试通过，说明安装成功！ - ---- - -## 快速开始 - -### 最简单的使用方式 - -```vba -Sub QuickStart() - ' 1. 创建BOM管理器并加载数据 - Dim bomMgr As New clsBOMManager - bomMgr.LoadData ThisWorkbook.Worksheets("领料配置"), _ - ThisWorkbook.Worksheets("平台配置清单") - - ' 2. 根据型号获取物料 - Dim modelStr As String - modelStr = "YTHN-100.A0.532.M203.M16.Y3" - - Dim materials As Collection - Set materials = bomMgr.GetMaterialsByModel(modelStr, "部件") - - ' 3. 查看结果 - Dim mat As clsMaterialItem - For Each mat In materials - Debug.Print mat.Code & " - " & mat.Name - Next mat -End Sub -``` - -### 生成领料清单 - -运行以下示例生成完整的领料清单: - -```vba -Example1_GeneratePickingListByModel -``` - -这将创建一个新工作表，包含完整的领料清单。 - ---- - -## 详细使用 - -### 1. 型号解析 - -#### 基础解析 - -```vba -Dim parser As New clsModelParser -Dim modelStr As String -modelStr = "YTHN-100.A0.532.M203.M16.Y3|BP-095.2312.M16.PA3" - -If parser.ParseModel(modelStr) Then - ' 解析成功 - Debug.Print "型号: " & parser.ModelType ' YTHN - Debug.Print "外径: " & parser.Diameter ' 100 - Debug.Print "过程连接: " & parser.ConnectionCode ' M203 - Debug.Print "量程: " & parser.RangeCode ' M16 -Else - ' 解析失败 - Debug.Print "错误: " & parser.ErrorMessage -End If -``` - -#### 获取提取的代码 - -```vba -Debug.Print "螺纹代码: " & parser.GetThreadCode() ' M20 -Debug.Print "材质代码: " & parser.GetMaterialCode() ' 3 -Debug.Print "量程代码: " & parser.GetRangeCode() ' M16 -``` - -### 2. 条件提取 - -```vba -Dim parser As New clsModelParser -parser.ParseModel "YTHN-100.A0.532.M203.M16.Y3" - -Dim extractor As New clsConditionExtractor -Dim conditions As Object -Set conditions = extractor.ExtractConditions(parser) - -' 获取单个条件 -Debug.Print "过程连接: " & extractor.GetConditionValue("gclj") ' M20 -Debug.Print "接液材质: " & extractor.GetConditionValue("jycz") ' 3 -Debug.Print "量程范围: " & extractor.GetConditionValue("lcfw") ' M16 - -' 遍历所有条件 -Dim key As Variant -For Each key In conditions.Keys - Debug.Print key & " = " & conditions(key) -Next key -``` - -### 3. 条件匹配 - -#### 简单条件 - -```vba -Dim matcher As New clsConditionMatcher -Dim conditions As Object -Set conditions = CreateObject("Scripting.Dictionary") -conditions("gclj") = "M20" -conditions("lcfw") = "M16" - -' 等于 -Debug.Print matcher.IsMatch("lcfw=M16", conditions) ' True - -' 不等于 -Debug.Print matcher.IsMatch("gclj!=M10", conditions) ' True -``` - -#### 复合条件 - -```vba -' AND 运算 -Debug.Print matcher.IsMatch("lcfw=M16 AND gclj=M20", conditions) ' True - -' OR 运算 -Debug.Print matcher.IsMatch("lcfw=M16 OR lcfw=M17", conditions) ' True - -' 括号优先级 -Debug.Print matcher.IsMatch("gclj=M20 AND (lcfw=M16 OR lcfw=M17)", conditions) ' True -``` - -### 4. 获取物料清单 - -#### 指定类别 - -```vba -Dim bomMgr As New clsBOMManager -bomMgr.LoadData wsConfig, wsPlatform - -' 获取"部件"类别的符合条件的物料 -Dim materials As Collection -Set materials = bomMgr.GetMaterialsByModel("YTHN-100.A0.532.M203.M16.Y3", "部件") -``` - -#### 所有类别 - -```vba -' 获取所有类别的符合条件的物料 -Set materials = bomMgr.GetMaterialsByModel("YTHN-100.A0.532.M203.M16.Y3") -``` - -#### 使用父类别/子类别逻辑 - -```vba -' 使用父类别物料(默认) -Set materials = bomMgr.GetMaterialsByCategoryAndModel( _ - "YTHN-100.A0.532.M203.M16.Y3", "部件", True) - -' 使用子类别物料(库存不足时) -Set materials = bomMgr.GetMaterialsByCategoryAndModel( _ - "YTHN-100.A0.532.M203.M16.Y3", "部件", False) -``` - ---- - -## API参考 - -### clsModelParser - -| 方法/属性 | 说明 | 返回类型 | -|---------|------|---------| -| `ParseModel(modelStr)` | 解析型号字符串 | Boolean | -| `GetThreadCode()` | 获取螺纹代码 | String | -| `GetMaterialCode()` | 获取材质代码 | String | -| `GetRangeCode()` | 获取量程代码 | String | -| `IsValid` | 解析是否成功 | Boolean | -| `ErrorMessage` | 错误信息 | String | -| `ToString()` | 返回解析结果(调试用) | String | - -### clsConditionExtractor - -| 方法/属性 | 说明 | 返回类型 | -|---------|------|---------| -| `ExtractConditions(parser)` | 提取所有条件 | Dictionary | -| `GetConditionValue(varName)` | 获取单个条件值 | String | -| `AddCondition(varName, value)` | 手动添加条件 | - | -| `AddExtractionRule(...)` | 添加提取规则 | - | -| `ToString()` | 返回条件字符串(调试用) | String | - -### clsConditionMatcher - -| 方法 | 说明 | 返回类型 | -|-----|------|---------| -| `IsMatch(expr, conditions)` | 判断条件是否匹配 | Boolean | -| `TestExpression(expr)` | 测试表达式有效性 | String | - -### clsBOMManager (新增方法) - -| 方法 | 说明 | 返回类型 | -|-----|------|---------| -| `GetMaterialsByModel(modelStr, [categoryName])` | 根据型号获取物料 | Collection | -| `GetMaterialsByCategoryAndModel(...)` | 根据类别和型号获取物料 | Collection | -| `ParseModelAndExtractConditions(modelStr)` | 解析型号并返回条件 | Dictionary | - ---- - -## 扩展指南 - -### 添加新的提取条件 - -假设需要添加"表盘类型"条件: - -```vba -' 在 clsConditionExtractor.InitializeRules 方法中添加: -m_ExtractionRules("bplx") = Array("DialCode", "Direct") -``` - -### 添加新的提取方法 - -如果需要特殊的提取逻辑: - -```vba -' 在 clsConditionExtractor.ExtractValue 方法中添加: -Case "GetMiddleChars" - ' 提取中间几位字符 - If Len(sourceValue) > 4 Then - ExtractValue = Mid(sourceValue, 2, 3) - Else - ExtractValue = sourceValue - End If -``` - -### 扩展条件匹配运算符 - -在 `clsConditionMatcher.EvaluateSimpleCondition` 中添加新运算符: - -```vba -' 示例: 添加 > 运算符 -ElseIf InStr(cond, ">") > 0 Then - ' ... 实现大于比较 -``` - ---- - -## 常见问题 - -### Q1: 型号解析失败怎么办? - -**A**: 检查型号格式是否正确: -- 表头部分必须包含: `型号-外径.安装.壳体.连接.量程.[特性]` -- 各部分用 `.` 分隔 -- 表头和表盘用 `|` 分隔 - -### Q2: 条件匹配不准确? - -**A**: -1. 检查物料的选择条件表达式是否正确 -2. 运行 `Test3_ConditionMatcher` 验证匹配器功能 -3. 使用 `TestExpression` 方法测试具体表达式 - -### Q3: 如何调试条件提取? - -**A**: 使用以下代码查看提取结果: - -```vba -Dim conditions As Object -Set conditions = bomMgr.ParseModelAndExtractConditions(modelStr) - -Dim key As Variant -For Each key In conditions.Keys - Debug.Print key & " = " & conditions(key) -Next key -``` - -### Q4: 批量处理速度慢? - -**A**: -1. 避免在循环中重复加载BOM数据 -2. 使用 `GetMaterialsByModel` 一次性获取所有类别 -3. 考虑添加缓存机制 - -### Q5: 如何验证物料条件表达式? - -**A**: 运行示例: - -```vba -Example5_ValidateMaterialConditions -``` - -这将生成一个验证报告，显示所有物料条件的有效性。 - ---- - -## 测试用例 - -### 运行所有测试 - -```vba -RunAllTests -``` - -### 单独测试 - -```vba -' 测试型号解析 -Test1_ModelParser - -' 测试条件提取 -Test2_ConditionExtractor - -' 测试条件匹配 -Test3_ConditionMatcher - -' 测试完整流程 -Test4_GetMaterialsByModel -``` - ---- - -## 应用示例 - -### 示例1: 生成领料清单 - -```vba -Example1_GeneratePickingListByModel -``` - -### 示例2: 批量处理型号 - -```vba -Example2_BatchProcessModels -``` - -### 示例3: 查询型号详情 - -```vba -Example3_ShowModelDetails -``` - -### 示例4: 对比两个型号 - -```vba -Example4_CompareModels -``` - -### 示例5: 验证条件表达式 - -```vba -Example5_ValidateMaterialConditions -``` - ---- - -## 技术支持 - -如有问题，请: -1. 查看测试结果和调试信息 -2. 运行相关示例程序 -3. 检查条件表达式语法 - ---- - -**文档版本**: v1.0 -**最后更新**: 2026-01-19 \ No newline at end of file diff --git a/reference_docs/平台配置清单.md b/reference_docs/平台配置清单.md deleted file mode 100644 index 2b71a9b..0000000 --- a/reference_docs/平台配置清单.md +++ /dev/null @@ -1,11 +0,0 @@ -| | A | B | C | D | E | F | G | H | I | J | K | -| --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | -| 1 | 代号 | YTHN-100 | 描述 | | 英文名称 | | | | | | | -| 2 | 名称 | (不锈钢)耐震压力表 | 负责人 | | 备注 | | | | | | | -| 3 | 行号 | 模块 | 代号 | 名称 | 数量 | 选择条件 | 备注 | 类别 | 上层类别 | 类别选用条件 | 66代码 | -| 4 | 10 | 316L部件 | 01011009557 | 径向低压接头部件 | 1.0 | gclj=M20 AND jycz=1 AND lcfw=M01 AND (azxs=A0 OR azxs=AT OR azxs=AH) | | 部件 | | | 66021009557 | -| 5 | 20 | 316L部件 | 01011009520 | 径向低压接头部件 | 1.0 | gclj=M20 AND jycz=1 AND lcfw=M02 AND (azxs=A0 OR azxs=AT OR azxs=AH) | | 部件 | | | 66021009520 | -| 6 | 30 | 316L部件 | 01011013536 | 径向低压接头部件 | 1.0 | gclj=M20 AND jycz=1 AND lcfw=M03 AND (azxs=A0 OR azxs=AT OR azxs=AH) | | 部件 | | | 66021013536 | -| 7 | 40 | 316L部件 | 01011013538 | 径向低压接头部件 | 1.0 | gclj=M20 AND jycz=1 AND lcfw=M04 AND (azxs=A0 OR azxs=AT OR azxs=AH) | | 部件 | | | 66021013538 | -| 8 | 50 | 316L部件 | 01011009522 | 径向低压接头部件 | 1.0 | gclj=M20 AND jycz=1 AND lcfw=M05 AND (azxs=A0 OR azxs=AT OR azxs=AH) | | 部件 | | | 66021009522 | -| 9 | 60 | 316L部件 | 01011013336 | 径向低压接头部件 | 1.0 | gclj=M20 AND jycz=1 AND lcfw=M06 AND (azxs=A0 OR azxs=AT OR azxs=AH) | | 部件 | | | 66021013336 | \ No newline at end of file diff --git a/reference_docs/新增条件提取计划.md b/reference_docs/新增条件提取计划.md deleted file mode 100644 index d89b942..0000000 --- a/reference_docs/新增条件提取计划.md +++ /dev/null @@ -1,276 +0,0 @@ -# 新增条件提取功能实现计划 - -## 一、需求概述 - -需要向 `clsConditionExtractor.cls` 类增加两个新的条件提取： - -1. **安装形式 (azxs)** - 从型号中提取安装形式代码 -2. **表壳形式 (bkxs)** - 从型号中提取表壳形式代码 - -### 示例说明 - -以型号 `YTHN-100.A0.532.M203.M17.Y3|BP-095.2312.M17.P3` 为例： - -- **A0** = 安装形式代码（径向无边） -- **532** = 表壳形式代码，其中： - - `53` = 表壳类型（304外壳、安装式、可充油） - - `2` = 罩壳类型（外卡式） - ---- - -## 二、参考文档依据 - -根据 `布莱迪公司压力表产品选型大表.md` 文档： - -### 2.1 安装形式代码（第159-204行） - -| 代码 | 说明 | -|------|------| -| A0 | 径向无边 | -| AT | 径向前边 | -| AH | 径向后边 | -| AM | 膜片式径向 | -| Z0 | 中轴向无边 | -| B0 | 下轴向无边 | -| ... | （共20多种安装形式） | - -**提取规则**：直接提取2位代码（字母+数字组合） - -### 2.2 表壳形式代码（第207-266行） - -表壳形式由两部分组成：**表壳类型(2位) + 罩壳类型(1位)** - -#### 表壳类型示例： -| 代码 | 说明 | -|------|------| -| 00 | 特殊型 | -| 10 | 塑料表壳 | -| 20-24 | 碳钢喷塑外壳系列 | -| 30 | 坚固安全型 | -| 40 | 压铸铝喷塑外壳 | -| 50-55 | 304外壳系列 | -| 60-65 | 316L外壳系列 | - -#### 罩壳类型示例： -| 代码 | 说明 | -|------|------| -| 0 | 螺钉上紧式 | -| 1 | 内卡式 | -| 2 | 外卡式 | -| 3 | 滚边式 | -| 4-9 | （其他6种罩壳类型） | - -**提取规则**： -- 整体提取3位代码（如：532） -- 如果需要细分，可以拆分为： - - 前2位：表壳类型（如：53） - - 后1位：罩壳类型（如：2） - ---- - -## 三、技术实现方案 - -### 3.1 代码检查 - -检查 `clsModelParser` 类是否已包含以下属性： -- ✅ `InstallForm` - 安装形式代码 -- ✅ `ShellForm` - 表壳形式代码 - -**说明**：根据 `clsConditionExtractor.cls` 第113-116行显示，解析器已经支持这些字段。 - -### 3.2 提取规则设计 - -#### 规则1：安装形式 (azxs) -```vba -m_ExtractionRules("azxs") = Array("InstallForm", "Direct") -``` -- **源字段**：`InstallForm` -- **提取方法**：`Direct`（直接使用） - -#### 规则2：表壳形式 (bkxs) -```vba -m_ExtractionRules("bkxs") = Array("ShellForm", "Direct") -``` -- **源字段**：`ShellForm` -- **提取方法**：`Direct`（直接使用） - -### 3.3 修改位置 - -在 `clsConditionExtractor.cls` 的 `InitializeRules()` 方法中添加上述两条规则。 - -**修改位置**：第29-47行（InitializeRules 方法内部） - ---- - -## 四、实现步骤 - -### 步骤1：修改 clsConditionExtractor.cls - -在 `InitializeRules()` 方法中添加两个新的提取规则： - -```vba -Private Sub InitializeRules() - ' 规则格式: Dictionary(变量名) = Array(源字段, 提取方法) - - ' 规则1: 过程连接 (gclj) - m_ExtractionRules("gclj") = Array("ConnectionCode", "RemoveLastDigit") - - ' 规则2: 接液材质 (jycz) - m_ExtractionRules("jycz") = Array("ConnectionCode", "GetLastDigit") - - ' 规则3: 量程范围 (lcfw) - m_ExtractionRules("lcfw") = Array("RangeCode", "Direct") - - ' === 新增规则 === - ' 规则4: 安装形式 (azxs) - m_ExtractionRules("azxs") = Array("InstallForm", "Direct") - - ' 规则5: 表壳形式 (bkxs) - m_ExtractionRules("bkxs") = Array("ShellForm", "Direct") -End Sub -``` - -### 步骤2：验证 ExtractValue 方法 - -检查 `ExtractValue` 方法（第98-157行）是否已支持 `InstallForm` 和 `ShellForm` 源字段。 - -**确认点**： -- 第113-114行：`Case "InstallForm"` ✅ 已存在 -- 第115-116行：`Case "ShellForm"` ✅ 已存在 - -**结论**：无需修改 `ExtractValue` 方法，它已经支持所需的源字段。 - -### 步骤3：测试验证 - -创建或更新测试用例，验证提取功能： - -```vba -' 测试用例 -Dim parser As New clsModelParser -Dim extractor As New clsConditionExtractor -Dim conditions As Object - -' 解析型号 -parser.Parse "YTHN-100.A0.532.M203.M17.Y3|BP-095.2312.M17.P3" - -' 提取条件 -Set conditions = extractor.ExtractConditions(parser) - -' 验证结果 -Debug.Print "安装形式(azxs): " & conditions("azxs") ' 应输出: A0 -Debug.Print "表壳形式(bkxs): " & conditions("bkxs") ' 应输出: 532 -``` - ---- - -## 五、影响范围评估 - -### 5.1 影响的文件 - -| 文件 | 修改类型 | 说明 | -|------|----------|------| -| `VBA/ClassModules/clsConditionExtractor.cls` | 修改 | 添加2条提取规则 | - -### 5.2 兼容性 - -- ✅ **向后兼容**：新增规则不影响现有条件（gclj、jycz、lcfw）的提取 -- ✅ **现有测试**：无需修改现有测试用例 -- ⚠️ **物料匹配**：如需在物料选择条件中使用这些新条件，需在Excel表格的"选择条件"列中使用新变量名（azxs、bkxs） - -### 5.3 使用场景 - -新增的条件可以在以下场景中使用： - -1. **物料选择条件表达式** - ``` - azxs=A0 AND bkxs=532 - ``` - -2. **BOM完整性检查** - - 检查是否缺少特定安装形式的物料 - - 检查是否缺少特定表壳形式的物料 - -3. **数据分析和统计** - - 按安装形式统计物料需求 - - 按表壳形式统计物料需求 - ---- - -## 六、可选增强功能（未来扩展） - -### 6.1 表壳形式细分提取 - -如果需要将表壳形式细分为表壳类型和罩壳类型，可以添加： - -```vba -' 表壳类型（前2位） -m_ExtractionRules("bklx") = Array("ShellForm", "GetFirstTwoDigits") - -' 罩壳类型（后1位） -m_ExtractionRules("zklx") = Array("ShellForm", "GetLastDigit") -``` - -同时需要在 `ExtractValue` 方法中添加新的提取方法： -- `GetFirstTwoDigits`：取前2位字符 -- `GetLastDigit`：已存在，直接复用 - -### 6.2 条件验证 - -可以添加条件值验证功能，确保提取的值在合法范围内： - -```vba -Public Function ValidateCondition(varName As String, value As String) As Boolean - ' 验证安装形式是否合法 - ' 验证表壳形式是否合法 -End Function -``` - ---- - -## 七、实施清单 - -- [ ] 1. 备份 `clsConditionExtractor.cls` 文件 -- [ ] 2. 在 `InitializeRules()` 方法中添加 azxs 提取规则 -- [ ] 3. 在 `InitializeRules()` 方法中添加 bkxs 提取规则 -- [ ] 4. 更新代码注释，说明新增规则的用途 -- [ ] 5. 创建测试用例验证提取功能 -- [ ] 6. 运行现有测试套件，确保无回归问题 -- [ ] 7. 更新相关文档（如需要） -- [ ] 8. 提交代码变更 - ---- - -## 八、预期结果 - -实现完成后，系统将能够： - -1. ✅ 从产品型号中自动提取安装形式代码（azxs） -2. ✅ 从产品型号中自动提取表壳形式代码（bkxs） -3. ✅ 在物料选择条件表达式中使用这两个新变量 -4. ✅ 保持向后兼容，不影响现有功能 - -**测试验证示例**： - -输入型号：`YTHN-100.A0.532.M203.M17.Y3` - -提取结果： -- `gclj` = M20 -- `jycz` = 3 -- `lcfw` = M17 -- **`azxs` = A0** ⬅️ 新增 -- **`bkxs` = 532** ⬅️ 新增 - ---- - -## 九、备注 - -1. 本计划遵循现有代码的设计模式和命名规范 -2. 所有新增代码将包含中文注释，便于维护 -3. 修改完成后将更新 VBA 模块元数据（如需要） -4. 建议在Excel开发环境中先进行手动测试，确保功能正常 - ---- - -**文档版本**: 1.0 -**创建日期**: 2026-01-27 -**作者**: Claude Code diff --git a/reference_docs/重构计划-整合领料配置到平台配置清单.md b/reference_docs/重构计划-整合领料配置到平台配置清单.md deleted file mode 100644 index 99f9a27..0000000 --- a/reference_docs/重构计划-整合领料配置到平台配置清单.md +++ /dev/null @@ -1,650 +0,0 @@ -# 重构计划：整合 [领料配置] 到 [平台配置清单] - -## 一、背景概述 - -### 1.1 重构目标 - -将原有的 [领料配置] 表格的功能整合到 [平台配置清单] 中，简化数据结构，统一管理。 - -### 1.2 变化原因 - -- 原有设计：物料基础信息在 [平台配置清单]，类别配置在 [领料配置]，数据分散 -- 新设计：所有信息集中在 [平台配置清单] 一张表，便于维护 - ---- - -## 二、新工作表结构分析 - -### 2.1 新表结构 - -**[平台配置清单] 表结构**（第3行标题）： - -| 列 | 字段名 | 说明 | 示例 | -|---|--------|------|------| -| A | 行号 | 数据行序号 | 10, 20, 30 | -| B | 模块 | 模块分类 | 316L部件 | -| C | 代号 | 物料代号 | 01011009557 | -| D | 名称 | 物料名称 | 径向低压接头部件 | -| E | 数量 | 物料数量 | 1.0 | -| F | 选择条件 | 物料选用条件 | gclj=M20 AND jycz=1 | -| G | 备注 | 备注信息 | | -| **H** | **类别** | ⭐ 新增：物料所属类别 | 部件 | -| **I** | **上层类别** | ⭐ 新增：父类别名称 | | -| **J** | **类别选用条件** | ⭐ 新增：判断该类别是否需要 | lcfw=M02 | -| **K** | **66代码** | ⭐ 新增：66系统代码 | 66021009557 | - -### 2.2 字段说明 - -#### 新增字段详解 - -1. **类别（H列）** - - 类型：字符串 - - 说明：物料所属的类别名称 - - 示例：`部件`、`表壳`、`接头`、`机芯` - - 为空：表示该物料不属于任何类别（不需要领料） - -2. **上层类别（I列）** - - 类型：字符串 - - 说明：父类别的名称，用于构建类别层级树 - - 示例：`接头` 的上层类别是 `部件` - - 为空：表示该类别是根类别 - -3. **类别选用条件（J列）** ⭐ **关键字段** - - 类型：字符串（逻辑表达式） - - 说明：用于判断该类别是否需要被选用 - - 格式：与"选择条件"字段相同的逻辑表达式 - - 判断规则： - - **为空**：该类别总是需要（无条件） - - **不为空**：需要用型号提取的条件去匹配，匹配成功才需要 - - 示例： - - `lcfw=M02`：只有当量程是 M02 时才需要这个类别 - - `gclj=M20 AND jycz=1`：只有当过程连接是 M20 且接液材质是 1 时才需要 - -4. **66代码（K列）** - - 类型：字符串 - - 说明：66系统使用的代码（具体用途待补充） - - 示例：`66021009557` - ---- - -## 三、核心业务逻辑变化 - -### 3.1 旧逻辑（重构前） - -``` -有效性检查规则： -- 所有根类别都必须匹配到至少1个物料 -- 每个根类别（或其子类别）必须有且仅有1个物料匹配 -- 如果有任何一个类别不满足，则物料集合不完整 -``` - -**问题**： -- 无法表达"某些型号不需要某些类别"的情况 -- 例如：某些型号可能不需要"机芯"类别 - -### 3.2 新逻辑（重构后） - -``` -有效性检查规则： -- 第一步：确定哪些类别是该型号需要的 - - 遍历所有有物料的类别 - - 如果"类别选用条件"为空 → 该类别总是需要 - - 如果"类别选用条件"不为空 → 用型号条件去匹配，匹配成功才需要 - -- 第二步：只检查需要的类别是否有物料匹配 - - 对于需要的类别，必须有且仅有1个物料匹配 - - 不需要的类别不参与完整性检查 -``` - -**示例场景**： - -型号：`YTHN-100.A0.532.M203.M16.Y3` (量程 M16) - -| 类别 | 类别选用条件 | 是否需要 | 说明 | -|------|-------------|---------|------| -| 表壳 | （空） | ✅ 需要 | 无条件，总是需要 | -| 部件 | lcfw=M02 | ❌ 不需要 | 型号量程是 M16，不满足条件 | -| 接头 | lcfw=M16 | ✅ 需要 | 型号量程是 M16，满足条件 | -| 机芯 | gclj=M20 | ❌ 不需要 | 型号过程连接不是 M20 | - -**结果**：只需要检查 `表壳` 和 `接头` 类别的物料完整性 - ---- - -## 四、代码影响分析 - -### 4.1 需要修改的模块和方法 - -#### 1. clsBOMManager 类 ⭐ **核心改动** - -**1.1 LoadData 方法** - -```vba -' 旧签名 -Public Sub LoadData(wsConfig As Worksheet, wsPlatform As Worksheet) - -' 新签名 -Public Sub LoadData(wsPlatform As Worksheet) -``` - -**变化**： -- ❌ 移除 `wsConfig` 参数（不再需要 [领料配置] 表） -- ✅ 所有数据从 [平台配置清单] 读取 -- ✅ 读取列数增加：从 A-F 扩展到 A-K - -**读取列对应**： -```vba -' 第一步：加载物料和类别信息（一次性完成） -For i = 4 To lastRow - ' 基础信息 - mat.code = Trim(wsPlatform.Cells(i, "C").value) ' 代号 - mat.Name = Trim(wsPlatform.Cells(i, "D").value) ' 名称 - mat.Quantity = CDbl(wsPlatform.Cells(i, "E").value) ' 数量 - mat.Condition = Trim(wsPlatform.Cells(i, "F").value) ' 选择条件 - - ' ⭐ 新增：类别相关字段 - 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代码 -Next i -``` - -**流程变化**： -``` -旧流程（三步）： - 1. 从 [平台配置清单] 加载物料基础信息 - 2. 从 [领料配置] 加载类别信息 - 3. 建立类别层级关系 - -新流程（两步）： - 1. 从 [平台配置清单] 加载物料和类别信息（一次性） - 2. 建立类别层级关系 -``` - ---- - -**1.2 GetValidMaterialsByModel 方法** - -**变化**： -- ✅ 需要先判断哪些类别是该型号需要的 -- ✅ 只检查需要的类别的完整性 - -**新逻辑**： -```vba -Public Function GetValidMaterialsByModel(modelStr As String) As collection - ' 1. 解析型号并提取条件 - Set conditions = ParseModelAndExtractConditions(modelStr) - - ' 2. ⭐ 新增：确定需要的类别列表 - Dim requiredCategories As collection - Set requiredCategories = GetRequiredCategories(conditions) - - ' 3. 只检查需要的类别 - For Each cat In requiredCategories - Set catResult = CheckCategoryCompleteness(cat, matcher, conditions) - ' ... - Next cat -End Function -``` - ---- - -**1.3 GetRequiredCategories 方法（新增）** - -**功能**：根据型号条件，确定哪些类别是需要的 - -```vba -Private Function GetRequiredCategories(conditions As Object) As collection - ' 遍历所有类别 - ' - 类别选用条件为空 → 添加到需要列表 - ' - 类别选用条件不为空 → 用 conditions 去匹配 - ' - 匹配成功 → 添加到需要列表 - ' - 匹配失败 → 不添加 -End Function -``` - ---- - -**1.4 CheckCategoryCompleteness 方法** - -**变化**： -- 无需修改，因为调用者已经过滤了不需要的类别 -- 逻辑保持不变：检查需要的类别是否有且仅有1个物料匹配 - ---- - -#### 2. clsCategory 类 ⭐ **需要扩展** - -**新增属性**： - -```vba -Public CategorySelectCondition As String ' ⭐ 新增：类别选用条件 -Public IsRequired As Boolean ' ⭐ 新增：是否需要（计算属性） -``` - -**新增方法**： - -```vba -' 检查该类别是否需要（根据型号条件） -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 -``` - ---- - -#### 3. clsMaterialItem 类 ⭐ **需要扩展** - -**新增属性**： - -```vba -Public CategorySelectCondition As String ' ⭐ 新增：类别选用条件 -Public Code66 As String ' ⭐ 新增：66代码 -``` - -**说明**： -- 物料需要保存所属类别的"类别选用条件" -- 便于后续判断该物料是否需要 - ---- - -### 4.2 不需要修改的方法 - -以下方法不受影响，无需修改： - -- ✅ `GetRootCategories()` - 获取根类别 -- ✅ `GetCategory(categoryName)` - 获取类别对象 -- ✅ `GetMaterialsByModel()` - 根据型号获取物料（不涉及完整性检查） -- ✅ `GetMaterialsForPicking()` - 获取领料物料 -- ✅ `ParseModelAndExtractConditions()` - 解析型号 -- ✅ `FilterCategoryWithSubcategories()` - 类别筛选 -- ✅ `CollectAllMaterials()` - 收集物料 -- ✅ `PrintCategoryTree()` - 打印类别树 - ---- - -## 五、重构实施计划 - -### 5.1 实施步骤 - -#### 阶段一：数据模型扩展（1-2小时） - -**任务清单**： - -1. ✅ **修改 clsMaterialItem 类** - - [ ] 添加 `CategorySelectCondition` 属性 - - [ ] 添加 `Code66` 属性 - - [ ] 更新类注释 - -2. ✅ **修改 clsCategory 类** - - [ ] 添加 `CategorySelectCondition` 属性 - - [ ] 添加 `IsRequiredForModel()` 方法 - - [ ] 更新类注释 - -3. ✅ **添加测试用例** - - [ ] 测试类别选用条件的匹配逻辑 - - [ ] 测试空条件和非空条件的情况 - ---- - -#### 阶段二：LoadData 方法重构（2-3小时） - -**任务清单**： - -1. ✅ **修改方法签名** - ```vba - ' 旧 - Public Sub LoadData(wsConfig As Worksheet, wsPlatform As Worksheet) - - ' 新 - Public Sub LoadData(wsPlatform As Worksheet) - ``` - -2. ✅ **重写加载逻辑** - - [ ] 移除第二步（从 [领料配置] 加载） - - [ ] 合并第一步和第二步（一次性从 [平台配置清单] 加载所有字段） - - [ ] 更新列索引映射： - - H列：类别 - - I列：上层类别 - - J列：类别选用条件 - - K列：66代码 - -3. ✅ **更新类别创建逻辑** - - [ ] 创建类别时，设置 `CategorySelectCondition` 属性 - - [ ] 创建物料时，设置 `CategorySelectCondition` 和 `Code66` 属性 - -4. ✅ **更新文档** - - [ ] 更新 `clsBOMManager_LoadData流程分析.md` - - [ ] 更新方法注释 - ---- - -#### 阶段三：完整性检查逻辑重构（2-3小时） - -**任务清单**： - -1. ✅ **新增 GetRequiredCategories 方法** - ```vba - Private Function GetRequiredCategories(conditions As Object) As collection - ' 遍历所有类别，判断是否需要 - ' 返回需要的类别列表 - End Function - ``` - -2. ✅ **修改 GetValidMaterialsByModel 方法** - - [ ] 在检查完整性前，先调用 `GetRequiredCategories()` - - [ ] 只对需要的类别调用 `CheckCategoryCompleteness()` - - [ ] 更新方法注释 - -3. ✅ **测试完整性检查** - - [ ] 测试所有类别都需要的情况（向后兼容） - - [ ] 测试部分类别不需要的情况（新逻辑） - - [ ] 测试边界情况（所有类别都不需要） - ---- - -#### 阶段四：测试与验证（2-3小时） - -**任务清单**： - -1. ✅ **单元测试** - - [ ] 测试 `LoadData` 加载新表结构 - - [ ] 测试 `IsRequiredForModel()` 方法 - - [ ] 测试 `GetRequiredCategories()` 方法 - - [ ] 测试 `GetValidMaterialsByModel()` 新逻辑 - -2. ✅ **集成测试** - - [ ] 使用真实数据测试完整流程 - - [ ] 验证结果与预期一致 - -3. ✅ **回归测试** - - [ ] 运行 `modModelParserTest` 中的所有测试 - - [ ] 确保旧功能不受影响 - ---- - -#### 阶段五：文档更新（1小时） - -**任务清单**： - -1. ✅ **更新 CLAUDE.md** - - [ ] 更新 [平台配置清单] 表结构说明 - - [ ] 移除 [领料配置] 相关说明 - - [ ] 更新"类别选用条件"业务逻辑说明 - -2. ✅ **更新参考文档** - - [ ] 更新 `clsBOMManager使用说明.md` - - [ ] 更新 `clsBOMManager_LoadData流程分析.md` - -3. ✅ **添加迁移指南** - - [ ] 创建 `数据迁移指南.md` - - [ ] 说明如何将旧数据迁移到新结构 - ---- - -### 5.2 风险评估 - -| 风险项 | 风险等级 | 缓解措施 | -|--------|---------|---------| -| 数据结构变化导致现有代码报错 | 🔴 高 | 充分的单元测试和回归测试 | -| 类别选用条件逻辑理解偏差 | 🟡 中 | 详细的业务场景测试 | -| 向后兼容性问题 | 🟡 中 | 保留旧版本的 LoadData 方法（重命名为 LoadDataV1） | -| 性能影响 | 🟢 低 | 新逻辑只增加一次类别过滤，影响极小 | - ---- - -### 5.3 时间估算 - -| 阶段 | 预计时间 | 负责人 | -|------|---------|--------| -| 阶段一：数据模型扩展 | 1-2 小时 | | -| 阶段二：LoadData 重构 | 2-3 小时 | | -| 阶段三：完整性检查重构 | 2-3 小时 | | -| 阶段四：测试与验证 | 2-3 小时 | | -| 阶段五：文档更新 | 1 小时 | | -| **总计** | **8-12 小时** | | - ---- - -## 六、数据迁移方案 - -### 6.1 从旧表到新表 - -**旧 [领料配置] 结构**： -| A列 | B列 | C列 | D列 | -|-----|-----|-----|-----| -| 物料代号 | 物料名称 | 类别 | 上层类别 | - -**新 [平台配置清单] 结构**： -| ... | H列 | I列 | J列 | K列 | -|-----|-----|-----|-----|-----| -| ... | 类别 | 上层类别 | 类别选用条件 | 66代码 | - -**迁移步骤**： - -1. **在 [平台配置清单] 中添加新列**： - - H列：类别 - - I列：上层类别 - - J列：类别选用条件 - - K列：66代码 - -2. **从 [领料配置] 复制数据**： - ``` - H2 = [领料配置]!A2 ' 物料代号 → 类别（需要匹配） - I2 = [领料配置]!C2 ' 类别 - J2 = [领料配置]!D2 ' 上层类别 - ``` - -3. **使用 VLOOKUP 匹配物料**： - ```excel - H4 = VLOOKUP(C4, [领料配置]!A:D, 3, FALSE) ' 类别 - I4 = VLOOKUP(C4, [领料配置]!A:D, 4, FALSE) ' 上层类别 - ``` - -4. **手动填写类别选用条件和66代码** - ---- - -## 七、测试用例设计 - -### 7.1 类别选用条件测试 - -| 测试场景 | 类别选用条件 | 型号条件 | 预期结果 | -|---------|-------------|---------|---------| -| 无条件（总是需要） | （空） | 任意 | ✅ 需要 | -| 量程匹配 | lcfw=M02 | lcfw=M02 | ✅ 需要 | -| 量程不匹配 | lcfw=M02 | lcfw=M16 | ❌ 不需要 | -| 复杂条件匹配 | gclj=M20 AND jycz=1 | gclj=M20, jycz=1 | ✅ 需要 | -| 复杂条件不匹配 | gclj=M20 AND jycz=1 | gclj=M20, jycz=2 | ❌ 不需要 | -| OR 条件匹配 | lcfw=M02 OR lcfw=M16 | lcfw=M16 | ✅ 需要 | - -### 7.2 完整性检查测试 - -| 测试场景 | 需要的类别 | 匹配结果 | 预期 IsComplete | -|---------|-----------|---------|-----------------| -| 全部匹配 | 表壳, 部件, 接头 | 全部有1个 | ✅ True | -| 缺失一个 | 表壳, 部件, 接头 | 部件缺失 | ❌ False | -| 部分类别不需要 | 表壳, 部件 | 表壳有, 部件无（但部件不需要） | ✅ True | -| 多于一个匹配 | 表壳, 部件 | 部件有2个 | ❌ False | - ---- - -## 八、向后兼容性策略 - -### 8.1 保留旧版本方法 - -```vba -' 旧版本（保留但不推荐使用） -Public Sub LoadDataV1(wsConfig As Worksheet, wsPlatform As Worksheet) - ' 保留原有实现 -End Sub - -' 新版本（推荐使用） -Public Sub LoadData(wsPlatform As Worksheet) - ' 新实现 -End Sub -``` - -### 8.2 迁移期支持 - -在迁移期间，两个版本同时存在： -- 新代码使用 `LoadData(wsPlatform)` -- 旧代码可以继续使用 `LoadDataV1(wsConfig, wsPlatform)` - -迁移完成后，可以移除 `LoadDataV1` 方法。 - ---- - -## 九、检查清单 - -### 重构前 - -- [ ] 备份现有代码 -- [ ] 备份 [领料配置] 和 [平台配置清单] 表 -- [ ] 确认测试环境可用 - -### 重构中 - -- [ ] 按阶段顺序执行 -- [ ] 每个阶段完成后进行测试 -- [ ] 及时更新文档 - -### 重构后 - -- [ ] 运行完整的测试套件 -- [ ] 验证所有功能正常 -- [ ] 更新用户文档 -- [ ] 通知团队成员变更内容 - ---- - -## 十、后续优化建议 - -1. **性能优化** - - 缓存类别选用条件的匹配结果 - - 避免重复解析型号 - -2. **功能扩展** - - 支持类别优先级（当多个类别都匹配时，优先选择哪个） - - 支持类别别名（一个类别多个名称） - -3. **用户体验** - - 在 Excel 中添加类别选用条件的验证工具 - - 提供类别选用条件的构建器（图形化界面） - ---- - -## 附录：关键代码示例 - -### A. 修改后的 LoadData 方法（伪代码） - -```vba -Public Sub LoadData(wsPlatform As Worksheet) - Dim i As Long, lastRow As Long - Dim mat As clsMaterialItem - Dim cat As clsCategory - - ' 读取数据 - lastRow = wsPlatform.Cells(wsPlatform.Rows.Count, "C").End(xlUp).row - - For i = 4 To lastRow - ' 1. 创建物料对象 - Set mat = New clsMaterialItem - mat.code = Trim(wsPlatform.Cells(i, "C").value) - mat.Name = Trim(wsPlatform.Cells(i, "D").value) - mat.Quantity = CDbl(wsPlatform.Cells(i, "E").value) - mat.Condition = Trim(wsPlatform.Cells(i, "F").value) - - ' ⭐ 读取类别相关字段 - 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 & "") - - ' ⭐ 保存到物料对象 - mat.Category = catName - mat.ParentCategory = parentCatName - mat.CategorySelectCondition = catSelectCond - mat.Code66 = code66 - - ' 保存到字典 - If mat.code <> "" Then - Set dictAllMaterials(mat.code) = mat - End If - - ' ⭐ 创建或更新类别对象 - 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 - - ' 建立类别层级关系（逻辑不变） - ' ... -End Sub -``` - -### B. 新增 GetRequiredCategories 方法（伪代码） - -```vba -Private Function GetRequiredCategories(conditions As Object) As collection - Dim result As New collection - Dim matcher As New clsConditionMatcher - - ' 遍历所有类别 - 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 -``` - -### C. 新增 clsCategory.IsRequiredForModel 方法（伪代码） - -```vba -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 -``` - ---- - -**文档版本**：v1.0 -**创建日期**：2026-01-29 -**最后更新**：2026-01-29