From 093a2d0a3bdb18ba961a7e3ce7afd24fd0f5f59e Mon Sep 17 00:00:00 2001 From: Misaka_Company Date: Thu, 12 Feb 2026 13:02:14 +0800 Subject: [PATCH] feat: implement BOM auto-extraction system MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Add complete BOM auto-extraction system with the following modules: - M06_ModelParser: Parse product model strings to extract parameters (azxs, bkxs, gclj, jycz, lcfw, fjgn) - Extracts header part from full model (ignores dial/attachment parts) - Splits process connection and material code (G123 -> G12, 3) - Supports multiple additional features with comma/dot separators - M07_BOMMatcher: Match materials in BOM library - Exact match, wildcard (empty cell), negative match (!=) - Special fjgn contains matching logic - Array-based performance optimization for bulk operations - M08_ComponentProcessor: Handle component material special logic - Component inventory check (interface reserved) - Sub-component extraction (joint + elastic element) - Combination validation rules (1 component OR 1 joint + 1 element) - M09_BOMExtractor: Main extraction orchestrator - Reads input models from worksheet - Processes each model and matches all material types - Outputs to "BOM提取结果" worksheet - Error reporting and non-blocking design - M06B_TestRunner: Comprehensive unit tests - 8 test cases for model parsing - 5 test cases for BOM matching - 5 test cases for component processing - M04_Config: Add BOM extraction constants - BOM library filename and configuration - Input/output column definitions - Output column enumeration - M01_Main: Add RunBOMExtraction entry point Co-Authored-By: Claude Sonnet 4.5 --- VBA_BOMConverter/Modules/M01_Main.bas | 27 +- VBA_BOMConverter/Modules/M04_Config.bas | 42 + VBA_BOMConverter/Modules/M06B_TestRunner.bas | 412 ++++++++++ VBA_BOMConverter/Modules/M06_ModelParser.bas | 299 ++++++++ VBA_BOMConverter/Modules/M07_BOMMatcher.bas | 434 +++++++++++ .../Modules/M08_ComponentProcessor.bas | 478 ++++++++++++ VBA_BOMConverter/Modules/M09_BOMExtractor.bas | 716 ++++++++++++++++++ 7 files changed, 2405 insertions(+), 3 deletions(-) create mode 100644 VBA_BOMConverter/Modules/M06B_TestRunner.bas create mode 100644 VBA_BOMConverter/Modules/M06_ModelParser.bas create mode 100644 VBA_BOMConverter/Modules/M07_BOMMatcher.bas create mode 100644 VBA_BOMConverter/Modules/M08_ComponentProcessor.bas create mode 100644 VBA_BOMConverter/Modules/M09_BOMExtractor.bas diff --git a/VBA_BOMConverter/Modules/M01_Main.bas b/VBA_BOMConverter/Modules/M01_Main.bas index 0cac67f..4074d1c 100644 --- a/VBA_BOMConverter/Modules/M01_Main.bas +++ b/VBA_BOMConverter/Modules/M01_Main.bas @@ -4,6 +4,10 @@ ' ============================================================================== Option Explicit +' ------------------------------------------------------------------------------ +' 入口1: 运行BOM转换系统（原功能） +' 功能: 从"平台配置清单"读取数据，解析条件规则，生成分类BOM +' ------------------------------------------------------------------------------ Public Sub RunBOMConversion() Dim wsSrc As Worksheet Dim arrData As Variant @@ -126,6 +130,23 @@ MainErrorHandler: Resume ExitHandler End Sub +' ------------------------------------------------------------------------------ +' 入口2: 运行BOM自动提取系统（新功能） +' 功能: 从产品型号中提取参数，匹配BOM库，输出标准BOM清单 +' +' 使用方法: +' 1. 在当前工作簿中准备"产品型号"列的工作表 +' 2. 确保BOM库.xlsx在同一目录下 +' 3. 运行此函数 +' +' 输出: 在"BOM提取结果"工作表中显示提取结果 +' ------------------------------------------------------------------------------ +Public Sub RunBOMExtraction() + Dim result As String + result = M09_BOMExtractor.RunBOMExtraction() + MsgBox result, vbInformation, "BOM提取" +End Sub + ' ============================================================================== ' 过程: GeneratePreprocessingReport ' 职责: 生成预处理条件转换对比报表，展示"接头"类别的条件转换结果 @@ -457,7 +478,7 @@ Private Function ContainsAzxsChange( _ regex.Global = True regex.IgnoreCase = True - regex.Pattern = "(azxs)( *=|!= *)([a-zA-Z0-9]{2})" + regex.pattern = "(azxs)( *=|!= *)([a-zA-Z0-9]{2})" ' 提取原始azxs值 Dim origMatches As Object @@ -499,7 +520,7 @@ Private Function ContainsLcfwChange( _ regex.Global = True regex.IgnoreCase = True - regex.Pattern = "(lcfw)( *=|!= *)([a-zA-Z]\d{1,3})" + regex.pattern = "(lcfw)( *=|!= *)([a-zA-Z]\d{1,3})" ' 提取原始lcfw值 Dim origMatches As Object @@ -585,7 +606,7 @@ Private Function ExtractFieldMappings( _ regex.Global = True regex.IgnoreCase = True - regex.Pattern = pattern + regex.pattern = pattern ' 从原始条件中提取所有该字段的值 Dim origMatches As Object diff --git a/VBA_BOMConverter/Modules/M04_Config.bas b/VBA_BOMConverter/Modules/M04_Config.bas index f26853e..c27a661 100644 --- a/VBA_BOMConverter/Modules/M04_Config.bas +++ b/VBA_BOMConverter/Modules/M04_Config.bas @@ -12,6 +12,48 @@ Public Const COL_IDX_COND As Long = 6 ' 选择条件 (F列) Public Const COL_IDX_CAT As Long = 8 ' 类别 (H列) Public Const SRC_START_ROW As Long = 4 ' 数据起始行 +' ------------------------------------------------------------------------------ +' BOM自动提取系统配置常量 +' ------------------------------------------------------------------------------ + +' BOM库配置 +Public Const BOMLIB_FILENAME As String = "BOM库.xlsx" +Public Const BOMLIB_START_ROW As Long = 2 ' BOM库数据起始行（第1行是表头） +Public Const OUTPUT_SHEET_NAME As String = "BOM提取结果" + +' 输入列名称配置 +Public Const INPUT_COL_MODEL As String = "型号" +Public Const INPUT_COL_PRODUCT_MODEL As String = "产品型号" + +' 输出列枚举 +Public Enum OutputColumns + oc_OriginalModel = 1 ' 原始产品型号 + oc_Azxs = 2 ' 安装形式 + oc_Bkxs = 3 ' 表壳形式 + oc_Gclj = 4 ' 过程连接 + oc_Jycz = 5 ' 接液材质 + oc_Lcfw = 6 ' 量程范围 + oc_Fjgn = 7 ' 附加功能 + oc_MaterialType = 8 ' 物料类型 + oc_MaterialName = 9 ' 物料名称 + oc_MaterialCode = 10 ' 物料编码 + oc_MaterialQty = 11 ' 物料数量 + oc_Remarks = 12 ' 提取备注 +End Enum + +' 型号解析常量 +Public Const MODEL_SEPARATOR_PIPELINE As String = "|" ' 管道符分隔符 +Public Const MODEL_SEPARATOR_DOT As String = "." ' 点号分隔符 +Public Const MODEL_SEPARATOR_CARET As String = "^" ' 插入符分隔符（法兰隔膜） +Public Const MODEL_HEADER_MIN_SEGMENTS As Long = 6 ' 表头最小段数 + +' BOM库工作表列表（需要遍历的工作表） +Public Const BOMLIB_SHEET_JOINT As String = "接头" +Public Const BOMLIB_SHEET_ELEMENT As String = "弹性元件" +Public Const BOMLIB_SHEET_MOVEMENT As String = "机芯" +Public Const BOMLIB_SHEET_COMPONENT As String = "部件" +Public Const BOMLIB_SHEET_EDGE As String = "边" + ' 获取表头排序索引 (越小越靠前) Public Function GetHeaderPriority(key As String) As Long Dim vList As Variant diff --git a/VBA_BOMConverter/Modules/M06B_TestRunner.bas b/VBA_BOMConverter/Modules/M06B_TestRunner.bas new file mode 100644 index 0000000..aeb87ff --- /dev/null +++ b/VBA_BOMConverter/Modules/M06B_TestRunner.bas @@ -0,0 +1,412 @@ +' ============================================================================== +' 模块: M06B_TestRunner +' 职责: BOM自动提取系统的单元测试 +' +' 测试模块: +' - M06_ModelParser: 型号解析测试 +' - M07_BOMMatcher: BOM匹配测试 +' - M08_ComponentProcessor: 部件处理测试 +' - M09_BOMExtractor: 提取流程测试 +' ============================================================================== +Option Explicit + +Private m_Logger As clsErrorLogger +Private m_FailCount As Long +Private m_PassCount As Long + +' ------------------------------------------------------------------------------ +' 主入口: 运行所有BOM提取测试 +' ------------------------------------------------------------------------------ +Public Sub RunBOMExtractionTests() + ' 初始化环境 + Set m_Logger = New clsErrorLogger + M06_ModelParser.InitModelParser m_Logger + M07_BOMMatcher.InitBOMMatcher m_Logger + M08_ComponentProcessor.InitComponentProcessor m_Logger + + m_FailCount = 0 + m_PassCount = 0 + + Debug.Print String(60, "=") + Debug.Print "开始运行BOM自动提取系统测试: " & Now + Debug.Print String(60, "-") + + ' M06_ModelParser 测试 + Debug.Print vbCrLf & "[M06_ModelParser 测试]" + Debug.Print String(60, "-") + Test_MP_01_简单型号解析 + Test_MP_02_复杂型号带管道符 + Test_MP_03_过程连接与材质分离 + Test_MP_04_量程范围提取 + Test_MP_05_附加功能提取 + Test_MP_06_多个附加功能 + Test_MP_07_不完整型号验证 + Test_MP_08_空型号处理 + + ' M07_BOMMatcher 测试 + Debug.Print vbCrLf & "[M07_BOMMatcher 测试]" + Debug.Print String(60, "-") + Test_BM_01_精确匹配 + Test_BM_02_空值通配符匹配 + Test_BM_03_否定条件匹配 + Test_BM_04_附加功能包含匹配 + Test_BM_05_fjgn包含逻辑 + + ' M08_ComponentProcessor 测试 + Debug.Print vbCrLf & "[M08_ComponentProcessor 测试]" + Debug.Print String(60, "-") + Test_CP_01_验证仅部件 + Test_CP_02_验证接头加弹性元件 + Test_CP_03_无效组合缺少弹性元件 + Test_CP_04_无效组合重复类型 + Test_CP_05_空物料列表验证 + + ' 汇总结果 + Debug.Print String(60, "-") + If m_FailCount = 0 Then + Debug.Print "测试结果: ALL PASS! (共 " & m_PassCount & " 个测试点)" + Else + Debug.Print "测试结果: 失败 " & m_FailCount & " 个, 通过 " & m_PassCount & " 个" + End If + Debug.Print String(60, "=") +End Sub + +' ============================================================================== +' M06_ModelParser 测试用例 +' ============================================================================== + +' ------------------------------------------------------------------------------ +' 测试用例 MP_01: 简单型号解析 +' ------------------------------------------------------------------------------ +Private Sub Test_MP_01_简单型号解析() + Dim params As Object + Set params = M06_ModelParser.ParseProductModel("YTHN-100.A0.531.G123.M04.Y3") + + Assert_NotNull params, "MP01_Params_Not_Null" + Assert_Equal params.count, 8, "MP01_Params_Count" + + Assert_Equal params("xh"), "YTHN", "MP01_xh" + Assert_Equal params("gcwj"), "100", "MP01_gcwj" + Assert_Equal params("azxs"), "A0", "MP01_azxs" + Assert_Equal params("bkxs"), "531", "MP01_bkxs" + Assert_Equal params("gclj"), "G12", "MP01_gclj" + Assert_Equal params("jycz"), "3", "MP01_jycz" + Assert_Equal params("lcfw"), "M04", "MP01_lcfw" + Assert_Equal params("fjgn"), "Y3", "MP01_fjgn" +End Sub + +' ------------------------------------------------------------------------------ +' 测试用例 MP_02: 复杂型号带管道符 +' ------------------------------------------------------------------------------ +Private Sub Test_MP_02_复杂型号带管道符() + Dim params As Object + Set params = M06_ModelParser.ParseProductModel("YTHN-100.A0.531.G123.M04.Y3|BP-088.2312.B09.0A3") + + Assert_NotNull params, "MP02_Params_Not_Null" + Assert_Equal params("azxs"), "A0", "MP02_azxs" + Assert_Equal params("bkxs"), "531", "MP02_bkxs" + Assert_Equal params("lcfw"), "M04", "MP02_lcfw" + Assert_Equal params("fjgn"), "Y3", "MP02_fjgn" +End Sub + +' ------------------------------------------------------------------------------ +' 测试用例 MP_03: 过程连接与材质分离 +' ------------------------------------------------------------------------------ +Private Sub Test_MP_03_过程连接与材质分离() + Dim params As Object + Set params = M06_ModelParser.ParseProductModel("YTHN-100.BZ.531.M201.M09.Y3") + + Assert_Equal params("gclj"), "M20", "MP03_gclj" + Assert_Equal params("jycz"), "1", "MP03_jycz" +End Sub + +' ------------------------------------------------------------------------------ +' 测试用例 MP_04: 量程范围提取 +' ------------------------------------------------------------------------------ +Private Sub Test_MP_04_量程范围提取() + Dim params1 As Object + Set params1 = M06_ModelParser.ParseProductModel("YTHN-100.A0.531.G123.M06.Y3") + Assert_Equal params1("lcfw"), "M06", "MP04_lcfw_M06" + + Dim params2 As Object + Set params2 = M06_ModelParser.ParseProductModel("YTHN-100.A0.531.G123.M16.Y3") + Assert_Equal params2("lcfw"), "M16", "MP04_lcfw_M16" +End Sub + +' ------------------------------------------------------------------------------ +' 测试用例 MP_05: 附加功能提取 +' ------------------------------------------------------------------------------ +Private Sub Test_MP_05_附加功能提取() + Dim params As Object + Set params = M06_ModelParser.ParseProductModel("YTHN-100.A0.531.G123.M04.N1.Y3") + + Assert_Equal params("fjgn"), "N1,Y3", "MP05_fjgn_N1" +End Sub + +' ------------------------------------------------------------------------------ +' 测试用例 MP_06: 多个附加功能 +' ------------------------------------------------------------------------------ +Private Sub Test_MP_06_多个附加功能() + Dim params1 As Object + Set params1 = M06_ModelParser.ParseProductModel("YTHN-100.A0.531.G123.M04.N1,N2.Y3") + Assert_Equal params1("fjgn"), "N1,N2,Y3", "MP06_fjgn_Comma" + + Dim params2 As Object + Set params2 = M06_ModelParser.ParseProductModel("YTHN-100.A0.531.G123.M04.N1.N2.Y3") + Assert_Equal params2("fjgn"), "N1,N2,Y3", "MP06_fjgn_Dot" +End Sub + +' ------------------------------------------------------------------------------ +' 测试用例 MP_07: 不完整型号验证 +' ------------------------------------------------------------------------------ +Private Sub Test_MP_07_不完整型号验证() + Dim params As Object + Set params = M06_ModelParser.ParseProductModel("YTHN-100.A0") + + ' 不完整型号仍应返回字典，但字段较少 + Assert_NotNull params, "MP07_Params_Not_Null" + Assert_True params.Exists("azxs"), "MP07_Has_azxs" + Assert_False params.Exists("bkxs"), "MP07_No_bkxs" +End Sub + +' ------------------------------------------------------------------------------ +' 测试用例 MP_08: 空型号处理 +' ------------------------------------------------------------------------------ +Private Sub Test_MP_08_空型号处理() + Dim params As Object + Set params = M06_ModelParser.ParseProductModel("") + + Assert_NotNull params, "MP08_Params_Not_Null" + Assert_Equal params.count, 0, "MP08_Empty_Count" +End Sub + +' ============================================================================== +' M07_BOMMatcher 测试用例 +' ============================================================================== + +' ------------------------------------------------------------------------------ +' 测试用例 BM_01: 精确匹配 +' ------------------------------------------------------------------------------ +Private Sub Test_BM_01_精确匹配() + Dim cellValue As String + cellValue = "A0" + Dim paramValue As String + paramValue = "A0" + + Dim result As Boolean + result = M07_BOMMatcher.EvaluateCellCondition(cellValue, paramValue, "azxs") + + Assert_Equal result, True, "BM01_Exact_Match" +End Sub + +' ------------------------------------------------------------------------------ +' 测试用例 BM_02: 空值通配符匹配 +' ------------------------------------------------------------------------------ +Private Sub Test_BM_02_空值通配符匹配() + Dim cellValue As Variant + cellValue = "" + Dim paramValue As String + paramValue = "A0" + + Dim result As Boolean + result = M07_BOMMatcher.EvaluateCellCondition(cellValue, paramValue, "azxs") + + Assert_Equal result, True, "BM02_Wildcard_Match" +End Sub + +' ------------------------------------------------------------------------------ +' 测试用例 BM_03: 否定条件匹配 +' ------------------------------------------------------------------------------ +Private Sub Test_BM_03_否定条件匹配() + Dim cellValue As String + cellValue = "!=A0" + Dim paramValue As String + paramValue = "B0" + + Dim result As Boolean + result = M07_BOMMatcher.EvaluateCellCondition(cellValue, paramValue, "azxs") + + Assert_Equal result, True, "BM03_Not_Equal_Match" +End Sub + +' ------------------------------------------------------------------------------ +' 测试用例 BM_04: 附加功能包含匹配 +' ------------------------------------------------------------------------------ +Private Sub Test_BM_04_附加功能包含匹配() + Dim cellValue As String + cellValue = "N1" + Dim fjgnList As String + fjgnList = "N1,N2,Y3" + + Dim result As Boolean + result = M07_BOMMatcher.CheckFjgnMatch(cellValue, fjgnList) + + Assert_Equal result, True, "BM04_Fjgn_Contains_N1" +End Sub + +' ------------------------------------------------------------------------------ +' 测试用例 BM_05: fjgn包含逻辑 +' ------------------------------------------------------------------------------ +Private Sub Test_BM_05_fjgn包含逻辑() + ' 测试包含 + Assert_True M07_BOMMatcher.CheckFjgnMatch("N3", "N3,N2"), "BM05_Contains_N3" + Assert_True M07_BOMMatcher.CheckFjgnMatch("N2", "N3,N2"), "BM05_Contains_N2" + + ' 测试不包含 + Assert_False M07_BOMMatcher.CheckFjgnMatch("N1", "N3,N2"), "BM05_Not_Contains_N1" + + ' 测试空列表 + Assert_False M07_BOMMatcher.CheckFjgnMatch("N1", ""), "BM05_Empty_List" +End Sub + +' ============================================================================== +' M08_ComponentProcessor 测试用例 +' ============================================================================== + +' ------------------------------------------------------------------------------ +' 测试用例 CP_01: 验证仅部件 +' ------------------------------------------------------------------------------ +Private Sub Test_CP_01_验证仅部件() + Dim materials As Collection + Set materials = New Collection + + Dim mat1 As Object + Set mat1 = CreateMaterial("部件", "部件A", "C001", 1) + materials.Add mat1 + + Dim validation As Object + Set validation = M08_ComponentProcessor.ValidateComponentCombination(materials) + + Assert_Equal validation("valid"), True, "CP01_Valid_Component" + Assert_True InStr(validation("message"), "1个部件") > 0, "CP01_Message_Content" +End Sub + +' ------------------------------------------------------------------------------ +' 测试用例 CP_02: 验证接头加弹性元件 +' ------------------------------------------------------------------------------ +Private Sub Test_CP_02_验证接头加弹性元件() + Dim materials As Collection + Set materials = New Collection + + Dim mat1 As Object + Set mat1 = CreateMaterial("接头", "接头A", "J001", 1) + materials.Add mat1 + + Dim mat2 As Object + Set mat2 = CreateMaterial("弹性元件", "元件A", "E001", 1) + materials.Add mat2 + + Dim validation As Object + Set validation = M08_ComponentProcessor.ValidateComponentCombination(materials) + + Assert_Equal validation("valid"), True, "CP02_Valid_Joint_Element" +End Sub + +' ------------------------------------------------------------------------------ +' 测试用例 CP_03: 无效组合缺少弹性元件 +' ------------------------------------------------------------------------------ +Private Sub Test_CP_03_无效组合缺少弹性元件() + Dim materials As Collection + Set materials = New Collection + + Dim mat1 As Object + Set mat1 = CreateMaterial("接头", "接头A", "J001", 1) + materials.Add mat1 + + Dim validation As Object + Set validation = M08_ComponentProcessor.ValidateComponentCombination(materials) + + Assert_Equal validation("valid"), False, "CP03_Invalid_No_Element" +End Sub + +' ------------------------------------------------------------------------------ +' 测试用例 CP_04: 无效组合重复类型 +' ------------------------------------------------------------------------------ +Private Sub Test_CP_04_无效组合重复类型() + Dim materials As Collection + Set materials = New Collection + + Dim mat1 As Object + Set mat1 = CreateMaterial("部件", "部件A", "C001", 1) + materials.Add mat1 + + Dim mat2 As Object + Set mat2 = CreateMaterial("接头", "接头A", "J001", 1) + materials.Add mat2 + + Dim validation As Object + Set validation = M08_ComponentProcessor.ValidateComponentCombination(materials) + + Assert_Equal validation("valid"), False, "CP04_Invalid_Both" +End Sub + +' ------------------------------------------------------------------------------ +' 测试用例 CP_05: 空物料列表验证 +' ------------------------------------------------------------------------------ +Private Sub Test_CP_05_空物料列表验证() + Dim materials As Collection + Set materials = New Collection + + Dim validation As Object + Set validation = M08_ComponentProcessor.ValidateComponentCombination(materials) + + Assert_Equal validation("valid"), False, "CP05_Empty_List" +End Sub + +' ============================================================================== +' 辅助函数 +' ============================================================================== + +' 辅助断言函数 +Private Sub Assert_Equal(actual As Variant, expected As Variant, testName As String) + If CStr(actual) = CStr(expected) Then + m_PassCount = m_PassCount + 1 + Else + Debug.Print " [FAIL] " & testName & " | Expected: " & expected & ", Actual: " & actual + m_FailCount = m_FailCount + 1 + End If +End Sub + +Private Sub Assert_True(actual As Boolean, testName As String) + If actual Then + m_PassCount = m_PassCount + 1 + Else + Debug.Print " [FAIL] " & testName & " | Expected: True, Actual: False" + m_FailCount = m_FailCount + 1 + End If +End Sub + +Private Sub Assert_False(actual As Boolean, testName As String) + If Not actual Then + m_PassCount = m_PassCount + 1 + Else + Debug.Print " [FAIL] " & testName & " | Expected: False, Actual: True" + m_FailCount = m_FailCount + 1 + End If +End Sub + +Private Sub Assert_NotNull(obj As Object, testName As String) + If Not obj Is Nothing Then + m_PassCount = m_PassCount + 1 + Else + Debug.Print " [FAIL] " & testName & " | Object is Nothing" + m_FailCount = m_FailCount + 1 + End If +End Sub + +' 创建测试物料对象 +Private Function CreateMaterial( _ + ByVal matType As String, _ + ByVal matName As String, _ + ByVal matCode As String, _ + ByVal matQty As Long _ +) As Object + Dim mat As Object + Set mat = CreateObject("Scripting.Dictionary") + mat("materialType") = matType + mat("materialName") = matName + mat("materialCode") = matCode + mat("materialQty") = matQty + mat("remarks") = "" + Set CreateMaterial = mat +End Function \ No newline at end of file diff --git a/VBA_BOMConverter/Modules/M06_ModelParser.bas b/VBA_BOMConverter/Modules/M06_ModelParser.bas new file mode 100644 index 0000000..8fe1a88 --- /dev/null +++ b/VBA_BOMConverter/Modules/M06_ModelParser.bas @@ -0,0 +1,299 @@ +' ============================================================================== +' 模块: M06_ModelParser +' 职责: 产品型号解析，从完整产品型号中提取关键参数 +' +' 产品型号结构: [表头]|[表盘]|[附件]|[法兰隔膜] +' 表头结构: [型号]-[公称外径].[安装形式].[壳体形式].[过程连接&接液材质].[量程范围].[仪表特性] +' +' 示例: YTHN-100.A0.531.G123.M04.Y3|BP-088.2312.B09.0A3 +' 表头: YTHN-100.A0.531.G123.M04.Y3 +' azxs: A0, bkxs: 531, gclj: G12, jycz: 3, lcfw: M04, fjgn: Y3 +' +' 注意: 仅处理表头部分，其他部分（表盘、附件、法兰隔膜）暂时丢弃 +' ============================================================================== +Option Explicit + +' 模块级变量 - 错误记录器 +Private g_Logger As clsErrorLogger + +' ------------------------------------------------------------------------------ +' 初始化型号解析器 +' ------------------------------------------------------------------------------ +Public Sub InitModelParser(logger As clsErrorLogger) + Set g_Logger = logger +End Sub + +' ------------------------------------------------------------------------------ +' 主入口: 解析产品型号 +' +' 输入: +' modelString - 完整的产品型号字符串 +' +' 输出: +' Object (Scripting.Dictionary) - 包含提取的参数 +' 键值对: "xh"->型号, "gcwj"->公称外径, "azxs"->安装形式, +' "bkxs"->表壳形式, "gclj"->过程连接, "jycz"->接液材质, +' "lcfw"->量程范围, "fjgn"->附加功能 +' +' 示例: +' Set params = ParseProductModel("YTHN-100.A0.531.G123.M04.Y3|BP-088.2312.B09.0A3") +' ' params("azxs") = "A0" +' ' params("gclj") = "G12" +' ' params("jycz") = "3" +' ------------------------------------------------------------------------------ +Public Function ParseProductModel(ByVal modelString As String) As Object + On Error GoTo ErrorHandler + + Dim params As Object + Set params = CreateObject("Scripting.Dictionary") + + ' 预处理：去除前后空格 + modelString = Trim(modelString) + + ' 如果型号为空，返回空字典 + If Len(modelString) = 0 Then + Set ParseProductModel = params + Exit Function + End If + + ' 步骤1: 提取表头部分（第一个管道符之前的部分） + Dim headerPart As String + headerPart = ExtractHeaderPart(modelString) + + If Len(headerPart) = 0 Then + If Not g_Logger Is Nothing Then + g_Logger.Record 0, "M06.ParseProductModel", "ModelParseError", _ + "无法提取表头部分，型号可能为空或格式错误", modelString + End If + Set ParseProductModel = params + Exit Function + End If + + ' 步骤2: 分割表头为段 + Dim segments As Variant + segments = SplitHeaderPart(headerPart) + + If Not IsArray(segments) Then + If Not g_Logger Is Nothing Then + g_Logger.Record 0, "M06.ParseProductModel", "ModelParseError", _ + "表头分割失败", headerPart + End If + Set ParseProductModel = params + Exit Function + End If + + ' 步骤3: 验证段数是否足够 + If UBound(segments) - LBound(segments) + 1 < MODEL_HEADER_MIN_SEGMENTS Then + If Not g_Logger Is Nothing Then + g_Logger.Record 0, "M06.ParseProductModel", "ModelParseError", _ + "表头段数不足，需要至少" & MODEL_HEADER_MIN_SEGMENTS & "段，实际" & _ + (UBound(segments) - LBound(segments) + 1) & "段", headerPart + End If + End If + + ' 步骤4: 提取型号和公称外径（预留，暂不参与BOM匹配） + Call ExtractModelAndSize(headerPart, params) + + ' 步骤5: 提取各参数 + ' 注意：segments(0)是"型号-公称外径"，需要从segments(1)开始提取参数 + If UBound(segments) - LBound(segments) + 1 >= 2 Then + params("azxs") = ExtractAzxs(segments(1)) + End If + + If UBound(segments) - LBound(segments) + 1 >= 3 Then + params("bkxs") = ExtractBkxs(segments(2)) + End If + + If UBound(segments) - LBound(segments) + 1 >= 4 Then + Dim gclj As String, jycz As String + Call ExtractGcljAndJycz(segments(3), gclj, jycz) + params("gclj") = gclj + params("jycz") = jycz + End If + + If UBound(segments) - LBound(segments) + 1 >= 5 Then + params("lcfw") = ExtractLcfw(segments(4)) + End If + + If UBound(segments) - LBound(segments) + 1 >= 6 Then + params("fjgn") = ExtractFjgn(segments, 5) + End If + + Set ParseProductModel = params + Exit Function + +ErrorHandler: + If Not g_Logger Is Nothing Then + g_Logger.Record 0, "M06.ParseProductModel", "SystemError", _ + "解析过程发生错误: " & Err.Description, modelString + End If + Set ParseProductModel = CreateObject("Scripting.Dictionary") +End Function + +' ------------------------------------------------------------------------------ +' 提取表头部分（管道符之前） +' +' 输入: YTHN-100.A0.531.G123.M04.Y3|BP-088.2312.B09.0A3 +' 输出: YTHN-100.A0.531.G123.M04.Y3 +' ------------------------------------------------------------------------------ +Private Function ExtractHeaderPart(ByVal fullModel As String) As String + Dim pipePos As Long + pipePos = InStr(fullModel, MODEL_SEPARATOR_PIPELINE) + + If pipePos > 0 Then + ExtractHeaderPart = Left(fullModel, pipePos - 1) + Else + ExtractHeaderPart = fullModel + End If +End Function + +' ------------------------------------------------------------------------------ +' 分割表头部分为段数组 +' +' 输入: YTHN-100.A0.531.G123.M04.Y3 +' 输出: Array("YTHN-100", "A0", "531", "G123", "M04", "Y3") +' ------------------------------------------------------------------------------ +Private Function SplitHeaderPart(ByVal headerPart As String) As Variant + ' 按点号分割 + Dim rawSegments As Variant + rawSegments = Split(headerPart, MODEL_SEPARATOR_DOT) + + ' 如果分割失败或结果为空 + If Not IsArray(rawSegments) Then + SplitHeaderPart = Null + Exit Function + End If + + ' 去除每个段的空格 + Dim i As Long + For i = LBound(rawSegments) To UBound(rawSegments) + rawSegments(i) = Trim(CStr(rawSegments(i))) + Next i + + SplitHeaderPart = rawSegments +End Function + +' ------------------------------------------------------------------------------ +' 提取型号和公称外径（预留字段） +' +' 输入: YTHN-100 +' 输出: params("xh")="YTHN", params("gcwj")="100" +' ------------------------------------------------------------------------------ +Private Sub ExtractModelAndSize(ByVal firstSegment As String, ByRef params As Object) + Dim dashPos As Long + dashPos = InStr(firstSegment, "-") + + If dashPos > 1 Then + params("xh") = Left(firstSegment, dashPos - 1) + Dim afterDash As String + afterDash = Mid(firstSegment, dashPos + 1) + + ' 提取-号后的数字部分（公称外径） + ' 因为firstSegment是"YTHN-100.A0..."，需要去掉后面的点号内容 + Dim dotPos As Long + dotPos = InStr(afterDash, ".") + If dotPos > 0 Then + params("gcwj") = Left(afterDash, dotPos - 1) + Else + params("gcwj") = afterDash + End If + End If +End Sub + +' ------------------------------------------------------------------------------ +' 提取安装形式 +' +' 输入: A0 +' 输出: A0 +' +' 规则: 直接返回第一段的值 +' ------------------------------------------------------------------------------ +Private Function ExtractAzxs(ByVal segment As String) As String + ExtractAzxs = Trim(segment) +End Function + +' ------------------------------------------------------------------------------ +' 提取表壳形式 +' +' 输入: 531 +' 输出: 531 +' +' 规则: 直接返回第二段的值 +' ------------------------------------------------------------------------------ +Private Function ExtractBkxs(ByVal segment As String) As String + ExtractBkxs = Trim(segment) +End Function + +' ------------------------------------------------------------------------------ +' 提取过程连接和接液材质 +' +' 输入: G123 +' 输出: gclj="G12", jycz="3" +' +' 规则: +' - 过程连接: 去除最后一位 +' - 接液材质: 最后一位 +' ------------------------------------------------------------------------------ +Private Sub ExtractGcljAndJycz(ByVal segment As String, ByRef gclj As String, ByRef jycz As String) + segment = Trim(segment) + + If Len(segment) >= 1 Then + jycz = Right(segment, 1) + If Len(segment) > 1 Then + gclj = Left(segment, Len(segment) - 1) + Else + gclj = "" + End If + Else + gclj = "" + jycz = "" + End If +End Sub + +' ------------------------------------------------------------------------------ +' 提取量程范围 +' +' 输入: M04 +' 输出: M04 +' +' 规则: 直接返回第四段的值 +' ------------------------------------------------------------------------------ +Private Function ExtractLcfw(ByVal segment As String) As String + ExtractLcfw = Trim(segment) +End Function + +' ------------------------------------------------------------------------------ +' 提取附加功能 +' +' 输入: segments数组，起始索引为4 +' 输出: Y3 或 N1,N2 或 N1.N2 +' +' 规则: +' - 从第五段开始，所有段合并为附加功能 +' - 用逗号或点号分隔的多个功能，保留原分隔符 +' - 示例: Y3 -> Y3 +' - 示例: N1,N2.Y3 -> N1,N2,Y3 +' ------------------------------------------------------------------------------ +Private Function ExtractFjgn(ByRef segments As Variant, ByVal startIndex As Long) As String + Dim result As String + result = "" + + Dim i As Long + For i = startIndex To UBound(segments) + Dim segment As String + segment = Trim(CStr(segments(i))) + + If Len(segment) > 0 Then + ' 替换点号为逗号（统一分隔符） + segment = Replace(segment, MODEL_SEPARATOR_DOT, ",") + + If Len(result) > 0 Then + result = result & "," & segment + Else + result = segment + End If + End If + Next i + + ExtractFjgn = result +End Function \ No newline at end of file diff --git a/VBA_BOMConverter/Modules/M07_BOMMatcher.bas b/VBA_BOMConverter/Modules/M07_BOMMatcher.bas new file mode 100644 index 0000000..eebb799 --- /dev/null +++ b/VBA_BOMConverter/Modules/M07_BOMMatcher.bas @@ -0,0 +1,434 @@ +' ============================================================================== +' 模块: M07_BOMMatcher +' 职责: BOM库匹配，根据提取的参数在BOM库中查找匹配的物料记录 +' +' 匹配规则: +' - 空单元格: 通配符，匹配所有值 +' - 单元格以"!="开头: 否定匹配，提取值不等于该值时匹配 +' - 普通值: 精确匹配 +' - fjgn字段: 包含匹配（InStr判断） +' +' 匹配逻辑: AND逻辑，所有条件列都必须满足 +' ============================================================================== +Option Explicit + +' 模块级变量 - 错误记录器 +Private g_Logger As clsErrorLogger + +' BOM库工作表数据缓存（用于性能优化） +Private g_BOMCache As Object +Private g_CacheWorkbookName As String + +' ------------------------------------------------------------------------------ +' 初始化BOM匹配器 +' ------------------------------------------------------------------------------ +Public Sub InitBOMMatcher(logger As clsErrorLogger) + Set g_Logger = logger + Set g_BOMCache = CreateObject("Scripting.Dictionary") + g_CacheWorkbookName = "" +End Sub + +' ------------------------------------------------------------------------------ +' 主入口: 在BOM库中匹配物料记录 +' +' 输入: +' ws - BOM库工作表（如"接头"、"弹性元件"等） +' params - 从产品型号中提取的参数字典（包含azxs, bkxs, gclj, jycz, lcfw, fjgn等） +' +' 输出: +' Object (Scripting.Dictionary) - 匹配结果 +' 键值对: "success"->Boolean, "rowCount"->Long, "rowNums"->Collection, "message"->String +' +' - success: 是否恰好匹配到1条记录 +' - rowCount: 匹配到的记录数量 +' - rowNums: 匹配到的行号集合 +' - message: 匹配结果描述（成功/失败原因） +' +' 示例: +' Set result = MatchBOMRecord(wsJoint, params) +' ' If result("success") Then +' ' ' 使用匹配到的记录 +' ' Else +' ' ' 记录错误到备注 +' ' End If +' ------------------------------------------------------------------------------ +Public Function MatchBOMRecord(ByVal ws As Worksheet, ByVal params As Object) As Object + On Error GoTo ErrorHandler + + Dim result As Object + Set result = CreateObject("Scripting.Dictionary") + + ' 验证输入 + If ws Is Nothing Then + result("success") = False + result("rowCount") = 0 + result("rowNums") = New Collection + result("message") = "工作表为空" + Set MatchBOMRecord = result + Exit Function + End If + + If params Is Nothing Or params.count = 0 Then + result("success") = False + result("rowCount") = 0 + result("rowNums") = New Collection + result("message") = "参数字典为空" + Set MatchBOMRecord = result + Exit Function + End If + + ' 读取工作表数据到数组（性能优化） + Dim bomData As Variant + Dim headerRow As Variant + Dim lastRow As Long + Dim lastCol As Long + + lastRow = ws.Cells(ws.Rows.count, 1).End(xlUp).row + lastCol = ws.Cells(1, ws.Columns.count).End(xlToLeft).Column + + ' 如果没有数据行 + If lastRow < BOMLIB_START_ROW Then + result("success") = False + result("rowCount") = 0 + result("rowNums") = New Collection + result("message") = "工作表无数据" + Set MatchBOMRecord = result + Exit Function + End If + + ' 读取数据到数组 + bomData = ws.Range(ws.Cells(BOMLIB_START_ROW, 1), ws.Cells(lastRow, lastCol)).Value + headerRow = ws.Range(ws.Cells(1, 1), ws.Cells(1, lastCol)).Value + + ' 构建表头映射（列名 -> 列索引） + Dim headerMap As Object + Set headerMap = BuildHeaderMapping(headerRow, lastCol) + + ' 遍历所有行，查找匹配 + Dim matchingRows As Collection + Set matchingRows = New Collection + + Dim r As Long + Dim RowIndex As Long + + For r = LBound(bomData, 1) To UBound(bomData, 1) + RowIndex = BOMLIB_START_ROW + (r - LBound(bomData, 1)) + + ' 评估该行是否匹配 + If EvaluateConditionRow(bomData, r, headerMap, params) Then + matchingRows.Add RowIndex + End If + Next r + + ' 构建结果 + result("rowCount") = matchingRows.count + Set result("rowNums") = matchingRows + + ' 判断匹配结果 + If matchingRows.count = 0 Then + result("success") = False + result("message") = "未找到匹配记录" + ElseIf matchingRows.count = 1 Then + result("success") = True + result("message") = "匹配成功" + Else + result("success") = False + result("message") = "匹配到" & matchingRows.count & "条记录（需要恰好1条）" + End If + + Set MatchBOMRecord = result + Exit Function + +ErrorHandler: + If Not g_Logger Is Nothing Then + g_Logger.Record 0, "M07.MatchBOMRecord", "SystemError", _ + "匹配过程发生错误: " & Err.Description, ws.Name + End If + + result("success") = False + result("rowCount") = 0 + Set result("rowNums") = New Collection + result("message") = "系统错误: " & Err.Description + Set MatchBOMRecord = result +End Function + +' ------------------------------------------------------------------------------ +' 评估单行数据是否匹配参数 +' +' 输入: +' bomData - BOM库数据数组 +' rowIdx - 数组行索引 +' headerMap - 表头映射（列名 -> 列索引） +' params - 提取的参数字典 +' +' 输出: +' Boolean - True表示该行匹配，False表示不匹配 +' +' 逻辑: +' - 对于参数字典中的每个键，在工作表中查找对应列 +' - 评估该列的单元格条件是否满足 +' - 所有条件都满足时返回True（AND逻辑） +' ------------------------------------------------------------------------------ +Private Function EvaluateConditionRow( _ + ByRef bomData As Variant, _ + ByVal rowIdx As Long, _ + ByVal headerMap As Object, _ + ByVal params As Object _ +) As Boolean + On Error GoTo ErrorHandler + + Dim paramKey As Variant + + ' 遍历所有参数 + For Each paramKey In params.keys + Dim paramValue As String + paramValue = CStr(params(paramKey)) + + ' 检查BOM库中是否有该列 + If headerMap.Exists(CStr(paramKey)) Then + Dim colIdx As Long + colIdx = headerMap(CStr(paramKey)) + + ' 获取单元格值 + Dim cellValue As Variant + cellValue = bomData(rowIdx, colIdx) + + ' 评估单元格条件 + If Not EvaluateCellCondition(cellValue, paramValue, CStr(paramKey)) Then + ' 只要有一个条件不满足，该行就不匹配 + EvaluateConditionRow = False + Exit Function + End If + End If + Next paramKey + + ' 所有条件都满足 + EvaluateConditionRow = True + Exit Function + +ErrorHandler: + EvaluateConditionRow = False +End Function + +' ------------------------------------------------------------------------------ +' 评估单个单元格条件是否满足 +' +' 输入: +' cellValue - BOM库单元格的值 +' paramValue - 从产品型号中提取的参数值 +' fieldName - 字段名称（用于特殊处理） +' +' 输出: +' Boolean - True表示条件满足，False表示不满足 +' +' 匹配规则: +' 1. 空单元格或IsEmpty: 通配符，匹配所有值（返回True） +' 2. 单元格以"!="开头: 否定匹配，paramValue不等于该值时返回True +' 3. fjgn字段: 包含匹配，paramValue包含cellValue时返回True +' 4. 普通值: 精确匹配，paramValue等于cellValue时返回True +' ------------------------------------------------------------------------------ +Public Function EvaluateCellCondition( _ + ByVal cellValue As Variant, _ + ByVal paramValue As String, _ + ByVal fieldName As String _ +) As Boolean + On Error GoTo ErrorHandler + + ' 处理空单元格（通配符） + If IsEmpty(cellValue) Or Len(Trim(CStr(cellValue))) = 0 Then + EvaluateCellCondition = True + Exit Function + End If + + Dim cellStr As String + cellStr = Trim(CStr(cellValue)) + + ' 处理否定条件 (!=开头） + If Left(cellStr, 2) = "!=" Then + Dim notValue As String + notValue = Trim(Mid(cellStr, 3)) + EvaluateCellCondition = (paramValue <> notValue) + Exit Function + End If + + ' 处理fjgn字段（包含匹配） + If LCase(fieldName) = "fjgn" Then + EvaluateCellCondition = CheckFjgnMatch(cellStr, paramValue) + Exit Function + End If + + ' 精确匹配 + EvaluateCellCondition = (paramValue = cellStr) + Exit Function + +ErrorHandler: + EvaluateCellCondition = False +End Function + +' ------------------------------------------------------------------------------ +' 检查附加功能(fjgn)是否匹配 +' +' 输入: +' cellValue - BOM库中的fjgn值（如: "N1" 或 "N3"） +' fjgnList - 从产品型号中提取的fjgn列表（如: "N1,N2" 或 "Y3"） +' +' 输出: +' Boolean - True表示fjgnList中包含cellValue +' +' 逻辑: +' - 使用InStr判断fjgnList中是否包含cellValue +' - 支持逗号分隔的多个功能 +' ------------------------------------------------------------------------------ +Public Function CheckFjgnMatch(ByVal cellValue As String, ByVal fjgnList As String) As Boolean + On Error GoTo ErrorHandler + + cellValue = Trim(cellValue) + fjgnList = Trim(fjgnList) + + ' 如果fjgn列表为空，不匹配 + If Len(fjgnList) = 0 Then + CheckFjgnMatch = False + Exit Function + End If + + ' 检查fjgnList中是否包含cellValue + ' 使用InStr进行包含匹配 + CheckFjgnMatch = (InStr(fjgnList, cellValue) > 0) + Exit Function + +ErrorHandler: + CheckFjgnMatch = False +End Function + +' ------------------------------------------------------------------------------ +' 构建表头映射（列名 -> 列索引） +' +' 输入: +' headerRow - 表头行数据数组（二维） +' lastCol - 最后一列的索引 +' +' 输出: +' Object (Scripting.Dictionary) - 表头映射字典 +' 键: 列名（小写），值: 列索引（从1开始） +' +' 示例: +' headerRow = Array("azxs", "bkxs", "gclj", "物料名称", "物料编码") +' 返回: {"azxs":1, "bkxs":2, "gclj":3, "物料名称":4, "物料编码":5} +' ------------------------------------------------------------------------------ +Private Function BuildHeaderMapping(ByRef headerRow As Variant, ByVal lastCol As Long) As Object + Dim headerMap As Object + Set headerMap = CreateObject("Scripting.Dictionary") + + Dim c As Long + For c = 1 To lastCol + Dim colName As String + colName = Trim(CStr(headerRow(1, c))) + + If Len(colName) > 0 Then + ' 使用小写作为键，避免大小写问题 + Dim colKey As String + colKey = LCase(colName) + + If Not headerMap.Exists(colKey) Then + headerMap.Add colKey, c + End If + End If + Next c + + Set BuildHeaderMapping = headerMap +End Function + +' ------------------------------------------------------------------------------ +' 从匹配行中提取物料信息 +' +' 输入: +' ws - BOM库工作表 +' rowNum - 匹配到的行号 +' headerMap - 表头映射 +' +' 输出: +' Object (Scripting.Dictionary) - 物料信息 +' 键值对: "materialName"->物料名称, "materialCode"->物料编码, +' "materialQty"->物料数量, "materialType"->物料类型（工作表名） +' +' 注意: +' - 默认查找"物料名称"、"物料编码"、"物料数量"列 +' - 如果列名不同，可以根据实际情况调整 +' ------------------------------------------------------------------------------ +Public Function ExtractMaterialInfo( _ + ByVal ws As Worksheet, _ + ByVal rowNum As Long, _ + ByVal headerMap As Object _ +) As Object + On Error GoTo ErrorHandler + + Dim materialInfo As Object + Set materialInfo = CreateObject("Scripting.Dictionary") + + ' 默认物料信息列名 + materialInfo("materialType") = ws.Name + + ' 查找物料名称列 + If headerMap.Exists("物料名称") Then + materialInfo("materialName") = Trim(CStr(ws.Cells(rowNum, headerMap("物料名称")).Value)) + Else + materialInfo("materialName") = "" + End If + + ' 查找物料编码列 + If headerMap.Exists("物料编码") Then + materialInfo("materialCode") = Trim(CStr(ws.Cells(rowNum, headerMap("物料编码")).Value)) + Else + materialInfo("materialCode") = "" + End If + + ' 查找物料数量列 + If headerMap.Exists("物料数量") Then + Dim qtyValue As Variant + qtyValue = ws.Cells(rowNum, headerMap("物料数量")).Value + If IsNumeric(qtyValue) Then + materialInfo("materialQty") = CLng(qtyValue) + Else + materialInfo("materialQty") = 1 + End If + Else + materialInfo("materialQty") = 1 + End If + + Set ExtractMaterialInfo = materialInfo + Exit Function + +ErrorHandler: + If Not g_Logger Is Nothing Then + g_Logger.Record rowNum, "M07.ExtractMaterialInfo", "SystemError", _ + "提取物料信息失败: " & Err.Description, ws.Name + End If + Set ExtractMaterialInfo = CreateObject("Scripting.Dictionary") +End Function + +' ------------------------------------------------------------------------------ +' 构建工作表的表头映射 +' +' 输入: +' ws - BOM库工作表 +' +' 输出: +' Object (Scripting.Dictionary) - 表头映射字典 +' +' 说明: +' - 公开函数，用于外部构建表头映射 +' ------------------------------------------------------------------------------ +Public Function BuildWorksheetHeaderMap(ByVal ws As Worksheet) As Object + If ws Is Nothing Then + Set BuildWorksheetHeaderMap = CreateObject("Scripting.Dictionary") + Exit Function + End If + + Dim lastCol As Long + lastCol = ws.Cells(1, ws.Columns.count).End(xlToLeft).Column + + Dim headerRow As Variant + headerRow = ws.Range(ws.Cells(1, 1), ws.Cells(1, lastCol)).Value + + Set BuildWorksheetHeaderMap = BuildHeaderMapping(headerRow, lastCol) +End Function \ No newline at end of file diff --git a/VBA_BOMConverter/Modules/M08_ComponentProcessor.bas b/VBA_BOMConverter/Modules/M08_ComponentProcessor.bas new file mode 100644 index 0000000..31664f8 --- /dev/null +++ b/VBA_BOMConverter/Modules/M08_ComponentProcessor.bas @@ -0,0 +1,478 @@ +' ============================================================================== +' 模块: M08_ComponentProcessor +' 职责: 处理"部件"物料的特殊逻辑 +' +' 部件物料特性: +' - 每条"部件"记录包含三个物料的数据： +' 1. 部件物料本身 +' 2. 接头物料（子件1） +' 3. 弹性元件物料（子件2） +' +' 选择策略: +' - 优先选择"部件"物料 +' - 当"部件"物料库存不足时，选择"接头"+"弹性元件" +' - 库存检查接口预留，当前默认返回True（库存充足） +' +' 验证规则: +' - 正常组合1: 1个部件 +' - 正常组合2: 1个接头 + 1个弹性元件 +' - 异常: 其他组合（如只有接头、只有弹性元件、同时有部件和接头等） +' ============================================================================== +Option Explicit + +' 模块级变量 - 错误记录器 +Private g_Logger As clsErrorLogger + +' ------------------------------------------------------------------------------ +' 初始化部件处理器 +' ------------------------------------------------------------------------------ +Public Sub InitComponentProcessor(logger As clsErrorLogger) + Set g_Logger = logger +End Sub + +' ------------------------------------------------------------------------------ +' 主入口: 处理"部件"记录，返回物料集合 +' +' 输入: +' wsComponent - "部件"工作表 +' params - 从产品型号中提取的参数字典 +' logger - 错误记录器 +' +' 输出: +' Collection - 物料集合 +' 每个元素是一个字典，包含: materialName, materialCode, materialQty, materialType, remarks +' +' 逻辑流程: +' 1. 在"部件"工作表中查找匹配记录 +' 2. 如果恰好匹配1条: +' a. 检查"部件"物料库存 +' b. 如果有库存，返回部件物料 +' c. 如果无库存，提取子件（接头+弹性元件） +' 3. 如果未匹配或多条匹配，记录错误 +' +' 示例: +' Set materials = ProcessComponentRecord(wsComponent, params, logger) +' ' materials(1) - 部件物料 或 接头物料 +' ' materials(2) - 弹性元件物料（如果选择子件） +' ------------------------------------------------------------------------------ +Public Function ProcessComponentRecord( _ + ByVal wsComponent As Worksheet, _ + ByVal params As Object, _ + ByVal logger As clsErrorLogger _ +) As Collection + On Error GoTo ErrorHandler + + Dim materials As Collection + Set materials = New Collection + + ' 步骤1: 在"部件"工作表中查找匹配记录 + Dim matchResult As Object + Set matchResult = M07_BOMMatcher.MatchBOMRecord(wsComponent, params) + + ' 步骤2: 判断匹配结果 + If Not matchResult("success") Then + ' 匹配失败（0条或多条），记录错误 + Dim errorMaterial As Object + Set errorMaterial = CreateObject("Scripting.Dictionary") + errorMaterial("materialType") = "部件" + errorMaterial("materialName") = "" + errorMaterial("materialCode") = "" + errorMaterial("materialQty") = 0 + errorMaterial("remarks") = matchResult("message") + materials.Add errorMaterial + + Set ProcessComponentRecord = materials + Exit Function + End If + + ' 步骤3: 获取匹配的行号 + Dim rowNum As Long + rowNum = matchResult("rowNums")(1) + + ' 步骤4: 构建表头映射 + Dim headerMap As Object + Set headerMap = M07_BOMMatcher.BuildWorksheetHeaderMap(wsComponent) + + ' 步骤5: 检查部件库存 + If CheckComponentInventory(wsComponent, rowNum, headerMap) Then + ' 库存充足，返回部件物料 + Dim componentInfo As Object + Set componentInfo = ExtractComponentInfo(wsComponent, rowNum, headerMap, "部件") + + If Not componentInfo Is Nothing Then + materials.Add componentInfo + End If + Else + ' 库存不足，提取子件（接头+弹性元件） + Dim subComponents As Collection + Set subComponents = ExtractSubComponents(wsComponent, rowNum, headerMap) + + Dim subComp As Variant + For Each subComp In subComponents + materials.Add subComp + Next subComp + End If + + Set ProcessComponentRecord = materials + Exit Function + +ErrorHandler: + If Not logger Is Nothing Then + logger.Record 0, "M08.ProcessComponentRecord", "SystemError", _ + "处理部件记录失败: " & Err.Description, "" + End If + + ' 返回错误物料 + Dim errorMat As Object + Set errorMat = CreateObject("Scripting.Dictionary") + errorMat("materialType") = "部件" + errorMat("materialName") = "" + errorMat("materialCode") = "" + errorMat("materialQty") = 0 + errorMat("remarks") = "系统错误: " & Err.Description + + Dim errorCol As New Collection + errorCol.Add errorMat + Set ProcessComponentRecord = errorCol +End Function + +' ------------------------------------------------------------------------------ +' 检查部件库存状态（预留接口） +' +' 输入: +' wsComponent - "部件"工作表 +' rowNum - 匹配到的行号 +' headerMap - 表头映射 +' +' 输出: +' Boolean - True表示有库存，False表示无库存 +' +' 注意: +' - 当前版本默认返回True（库存充足） +' - 预留接口，未来可连接ERP/库存系统 +' - 可扩展为查询库存Excel表或API +' ------------------------------------------------------------------------------ +Private Function CheckComponentInventory( _ + ByVal wsComponent As Worksheet, _ + ByVal rowNum As Long, _ + ByVal headerMap As Object _ +) As Boolean + ' TODO: 连接库存系统查询实际库存 + ' 当前版本默认返回True（库存充足） + + ' 示例扩展代码（注释）: + ' If headerMap.Exists("库存数量") Then + ' Dim stockQty As Long + ' stockQty = CLng(wsComponent.Cells(rowNum, headerMap("库存数量")).Value) + ' CheckComponentInventory = (stockQty > 0) + ' Else + ' CheckComponentInventory = True + ' End If + + CheckComponentInventory = True +End Function + +' ------------------------------------------------------------------------------ +' 提取部件物料信息 +' +' 输入: +' wsComponent - "部件"工作表 +' rowNum - 匹配到的行号 +' headerMap - 表头映射 +' componentType - 部件类型（"部件"） +' +' 输出: +' Object (Scripting.Dictionary) - 部件物料信息 +' 键值对: materialName, materialCode, materialQty, materialType, remarks +' ------------------------------------------------------------------------------ +Private Function ExtractComponentInfo( _ + ByVal wsComponent As Worksheet, _ + ByVal rowNum As Long, _ + ByVal headerMap As Object, _ + ByVal componentType As String _ +) As Object + On Error GoTo ErrorHandler + + Dim componentInfo As Object + Set componentInfo = CreateObject("Scripting.Dictionary") + + componentInfo("materialType") = componentType + + ' 查找物料名称列 + If headerMap.Exists("物料名称") Then + componentInfo("materialName") = Trim(CStr(wsComponent.Cells(rowNum, headerMap("物料名称")).Value)) + Else + componentInfo("materialName") = "" + End If + + ' 查找物料编码列 + If headerMap.Exists("物料编码") Then + componentInfo("materialCode") = Trim(CStr(wsComponent.Cells(rowNum, headerMap("物料编码")).Value)) + Else + componentInfo("materialCode") = "" + End If + + ' 查找物料数量列 + If headerMap.Exists("物料数量") Then + Dim qtyValue As Variant + qtyValue = wsComponent.Cells(rowNum, headerMap("物料数量")).Value + If IsNumeric(qtyValue) Then + componentInfo("materialQty") = CLng(qtyValue) + Else + componentInfo("materialQty") = 1 + End If + Else + componentInfo("materialQty") = 1 + End If + + componentInfo("remarks") = "" + + Set ExtractComponentInfo = componentInfo + Exit Function + +ErrorHandler: + If Not g_Logger Is Nothing Then + g_Logger.Record rowNum, "M08.ExtractComponentInfo", "SystemError", _ + "提取部件信息失败: " & Err.Description, componentType + End If + Set ExtractComponentInfo = Nothing +End Function + +' ------------------------------------------------------------------------------ +' 提取子部件信息（接头+弹性元件） +' +' 输入: +' wsComponent - "部件"工作表 +' rowNum - 匹配到的行号 +' headerMap - 表头映射 +' +' 输出: +' Collection - 子部件集合 +' 包含2个元素: 接头物料、弹性元件物料 +' +' 注意: +' - "部件"工作表中，子件信息存储在特定列中 +' - 需要根据实际的BOM库结构调整列名 +' - 默认查找"接头_物料名称"、"接头_物料编码"、"接头_物料数量"等列 +' ------------------------------------------------------------------------------ +Private Function ExtractSubComponents( _ + ByVal wsComponent As Worksheet, _ + ByVal rowNum As Long, _ + ByVal headerMap As Object _ +) As Collection + On Error GoTo ErrorHandler + + Dim subComponents As Collection + Set subComponents = New Collection + + ' 提取接头信息 + Dim jointInfo As Object + Set jointInfo = ExtractSingleSubComponent(wsComponent, rowNum, headerMap, "接头") + + If Not jointInfo Is Nothing Then + subComponents.Add jointInfo + End If + + ' 提取弹性元件信息 + Dim elementInfo As Object + Set elementInfo = ExtractSingleSubComponent(wsComponent, rowNum, headerMap, "弹性元件") + + If Not elementInfo Is Nothing Then + subComponents.Add elementInfo + End If + + Set ExtractSubComponents = subComponents + Exit Function + +ErrorHandler: + If Not g_Logger Is Nothing Then + g_Logger.Record rowNum, "M08.ExtractSubComponents", "SystemError", _ + "提取子件信息失败: " & Err.Description, "" + End If + Set ExtractSubComponents = New Collection +End Function + +' ------------------------------------------------------------------------------ +' 提取单个子部件信息 +' +' 输入: +' wsComponent - "部件"工作表 +' rowNum - 匹配到的行号 +' headerMap - 表头映射 +' subComponentType - 子件类型（"接头" 或 "弹性元件"） +' +' 输出: +' Object (Scripting.Dictionary) - 子件物料信息 +' +' 注意: +' - 列名格式: "接头_物料名称"、"接头_物料编码"、"接头_物料数量" +' - 或者: "子件1_物料名称"、"子件1_物料编码"等 +' ------------------------------------------------------------------------------ +Private Function ExtractSingleSubComponent( _ + ByVal wsComponent As Worksheet, _ + ByVal rowNum As Long, _ + ByVal headerMap As Object, _ + ByVal subComponentType As String _ +) As Object + On Error GoTo ErrorHandler + + Dim subInfo As Object + Set subInfo = CreateObject("Scripting.Dictionary") + + subInfo("materialType") = subComponentType + + ' 查找子件物料名称列 + Dim nameColKey As String + nameColKey = LCase(subComponentType & "_物料名称") + + If headerMap.Exists(nameColKey) Then + subInfo("materialName") = Trim(CStr(wsComponent.Cells(rowNum, headerMap(nameColKey)).Value)) + Else + subInfo("materialName") = "" + End If + + ' 查找子件物料编码列 + Dim codeColKey As String + codeColKey = LCase(subComponentType & "_物料编码") + + If headerMap.Exists(codeColKey) Then + subInfo("materialCode") = Trim(CStr(wsComponent.Cells(rowNum, headerMap(codeColKey)).Value)) + Else + subInfo("materialCode") = "" + End If + + ' 查找子件物料数量列 + Dim qtyColKey As String + qtyColKey = LCase(subComponentType & "_物料数量") + + If headerMap.Exists(qtyColKey) Then + Dim qtyValue As Variant + qtyValue = wsComponent.Cells(rowNum, headerMap(qtyColKey)).Value + If IsNumeric(qtyValue) Then + subInfo("materialQty") = CLng(qtyValue) + Else + subInfo("materialQty") = 1 + End If + Else + subInfo("materialQty") = 1 + End If + + subInfo("remarks") = "部件无库存，使用子件" + + Set ExtractSingleSubComponent = subInfo + Exit Function + +ErrorHandler: + If Not g_Logger Is Nothing Then + g_Logger.Record rowNum, "M08.ExtractSingleSubComponent", "SystemError", _ + "提取子件[" & subComponentType & "]失败: " & Err.Description, "" + End If + Set ExtractSingleSubComponent = Nothing +End Function + +' ------------------------------------------------------------------------------ +' 验证部件组合是否有效 +' +' 输入: +' materials - 物料集合（包含所有类型的物料） +' +' 输出: +' Object (Scripting.Dictionary) - 验证结果 +' 键值对: "valid"->Boolean, "message"->String +' +' 验证规则: +' - 正确组合1: 1个部件 +' - 正确组合2: 1个接头 + 1个弹性元件 +' - 异常: 其他组合 +' +' 示例: +' Set validation = ValidateComponentCombination(materials) +' ' If Not validation("valid") Then +' ' ' 记录验证错误 +' ' End If +' ------------------------------------------------------------------------------ +Public Function ValidateComponentCombination(ByVal materials As Collection) As Object + On Error GoTo ErrorHandler + + Dim result As Object + Set result = CreateObject("Scripting.Dictionary") + + If materials Is Nothing Or materials.count = 0 Then + result("valid") = False + result("message") = "物料列表为空" + Set ValidateComponentCombination = result + Exit Function + End If + + ' 统计各类型物料数量 + Dim componentCount As Long + Dim jointCount As Long + Dim elementCount As Long + Dim otherCount As Long + + componentCount = 0 + jointCount = 0 + elementCount = 0 + otherCount = 0 + + Dim mat As Variant + For Each mat In materials + Dim matType As String + matType = CStr(mat("materialType")) + + Select Case matType + Case "部件" + componentCount = componentCount + 1 + Case "接头" + jointCount = jointCount + 1 + Case "弹性元件" + elementCount = elementCount + 1 + Case Else + otherCount = otherCount + 1 + End Select + Next mat + + ' 验证组合规则 + ' 规则1: 只有1个部件，没有接头和弹性元件 + If componentCount = 1 And jointCount = 0 And elementCount = 0 Then + result("valid") = True + result("message") = "验证通过：1个部件" + Set ValidateComponentCombination = result + Exit Function + End If + + ' 规则2: 没有部件，恰好1个接头和1个弹性元件 + If componentCount = 0 And jointCount = 1 And elementCount = 1 Then + result("valid") = True + result("message") = "验证通过：1个接头+1个弹性元件" + Set ValidateComponentCombination = result + Exit Function + End If + + ' 其他情况都是异常 + Dim errorMsg As String + errorMsg = "部件组合异常: " + + If componentCount > 1 Then + errorMsg = errorMsg & "部件数量为" & componentCount & "（应为1）" + ElseIf componentCount = 1 And (jointCount > 0 Or elementCount > 0) Then + errorMsg = errorMsg & "同时存在部件和子件（不应共存）" + ElseIf jointCount <> elementCount Then + errorMsg = errorMsg & "接头数量(" & jointCount & ")≠弹性元件数量(" & elementCount & ")" + ElseIf jointCount = 0 And elementCount = 0 Then + errorMsg = errorMsg & "缺少部件和子件" + Else + errorMsg = errorMsg & "未知异常组合" + End If + + result("valid") = False + result("message") = errorMsg + + Set ValidateComponentCombination = result + Exit Function + +ErrorHandler: + result("valid") = False + result("message") = "验证过程发生错误: " & Err.Description + Set ValidateComponentCombination = result +End Function \ No newline at end of file diff --git a/VBA_BOMConverter/Modules/M09_BOMExtractor.bas b/VBA_BOMConverter/Modules/M09_BOMExtractor.bas new file mode 100644 index 0000000..c185d60 --- /dev/null +++ b/VBA_BOMConverter/Modules/M09_BOMExtractor.bas @@ -0,0 +1,716 @@ +' ============================================================================== +' 模块: M09_BOMExtractor +' 职责: BOM自动提取系统的主流程编排和结果输出 +' +' 主要流程: +' 1. 读取输入工作表中的产品型号列表 +' 2. 打开BOM库.xlsx文件 +' 3. 对于每个产品型号: +' a. 解析型号，提取参数（M06_ModelParser） +' b. 遍历BOM库工作表，匹配物料（M07_BOMMatcher） +' c. 特殊处理"部件"物料（M08_ComponentProcessor） +' d. 验证部件组合规则 +' e. 生成输出行 +' 4. 将结果写入"BOM提取结果"工作表 +' 5. 生成错误报告 +' +' 输出格式: +' - 纵向展开格式，每个物料一行 +' - 列: 原始产品型号, azxs, bkxs, gclj, jycz, lcfw, fjgn, +' 物料类型, 物料名称, 物料编码, 物料数量, 提取备注 +' ============================================================================== +Option Explicit + +' 模块级变量 +Private g_Logger As clsErrorLogger +Private g_BOMWorkbook As Workbook + +' ------------------------------------------------------------------------------ +' 主入口: 运行BOM提取流程 +' +' 输入: 无（从活动工作簿读取输入） +' +' 输出: +' String - 处理结果消息 +' +' 流程: +' 1. 初始化环境 +' 2. 读取输入产品型号 +' 3. 打开BOM库文件 +' 4. 处理每个产品型号 +' 5. 写入结果到工作表 +' 6. 生成错误报告 +' +' 示例调用: +' Dim result As String +' result = M09_BOMExtractor.RunBOMExtraction() +' MsgBox result +' ------------------------------------------------------------------------------ +Public Function RunBOMExtraction() As String + On Error GoTo MainErrorHandler + + ' 初始化 + Set g_Logger = New clsErrorLogger + Set g_BOMWorkbook = Nothing + + Application.ScreenUpdating = False + Application.Calculation = xlCalculationManual + Application.DisplayAlerts = False + + ' 步骤1: 检查输入工作表 + Dim wsInput As Worksheet + Set wsInput = ThisWorkbook.Worksheets("产品型号") + + If wsInput Is Nothing Then + RunBOMExtraction = "错误：未找到输入工作表。工作表名称应包含'" & INPUT_COL_MODEL & "'或'" & INPUT_COL_PRODUCT_MODEL & "'。" + GoTo ExitHandler + End If + + Application.StatusBar = "正在读取输入数据..." + + ' 步骤2: 读取输入产品型号 + Dim inputModels As Variant + inputModels = ReadInputModels(wsInput) + + If IsEmpty(inputModels) Then + RunBOMExtraction = "错误：未找到产品型号数据。请检查工作表中是否有数据。" + GoTo ExitHandler + End If + + ' 步骤3: 打开BOM库文件 + Application.StatusBar = "正在打开BOM库文件..." + + Set g_BOMWorkbook = OpenBOMLibrary() + + If g_BOMWorkbook Is Nothing Then + RunBOMExtraction = "错误：无法打开BOM库文件。请确保[" & BOMLIB_FILENAME & "]与当前工作簿在同一目录下。" + GoTo ExitHandler + End If + + ' 初始化各模块 + M06_ModelParser.InitModelParser g_Logger + M07_BOMMatcher.InitBOMMatcher g_Logger + M08_ComponentProcessor.InitComponentProcessor g_Logger + + ' 步骤4: 处理每个产品型号 + Application.StatusBar = "正在处理产品型号..." + + Dim allResults As Collection + Set allResults = New Collection + + Dim i As Long + Dim totalModels As Long + totalModels = UBound(inputModels, 1) + + For i = LBound(inputModels, 1) To UBound(inputModels, 1) + ' 进度更新 + If i Mod 10 = 0 Then + Dim pct As Long + pct = CLng((i / totalModels) * 100) + Application.StatusBar = "正在处理: " & pct & "% | 型号: " & i & "/" & totalModels + DoEvents + End If + + ' 处理单个型号 + Dim modelString As String + modelString = CStr(inputModels(i, 1)) + + Dim modelResults As Collection + Set modelResults = ProcessSingleModel(modelString, g_BOMWorkbook, g_Logger) + + ' 合并结果 + Dim result As Variant + For Each result In modelResults + allResults.Add result + Next result + Next i + + ' 步骤5: 写入结果到工作表 + Application.StatusBar = "正在写入结果..." + + Dim wsOutput As Worksheet + Set wsOutput = WriteExtractionResults(allResults) + + ' 步骤6: 生成错误报告 + If g_Logger.HasErrors Then + g_Logger.PrintReport ActiveWorkbook + End If + + ' 关闭BOM库文件 + If Not g_BOMWorkbook Is Nothing Then + g_BOMWorkbook.Close SaveChanges:=False + Set g_BOMWorkbook = Nothing + End If + + ' 构建返回消息 + Dim successCount As Long + Dim errorCount As Long + successCount = 0 + errorCount = 0 + + For Each result In allResults + If Len(CStr(result(12))) = 0 Then ' 第12列是备注 + successCount = successCount + 1 + Else + errorCount = errorCount + 1 + End If + Next result + + Dim msg As String + msg = "BOM提取完成！" & vbCrLf & _ + "处理型号数: " & totalModels & vbCrLf & _ + "提取物料数: " & allResults.count & vbCrLf & _ + "成功数: " & successCount & vbCrLf & _ + "异常数: " & errorCount + + If g_Logger.HasErrors Then + msg = msg & vbCrLf & vbCrLf & "发现错误，已生成错误报告工作表。" + End If + + RunBOMExtraction = msg + GoTo ExitHandler + +MainErrorHandler: + RunBOMExtraction = "发生运行时错误: " & Err.Description & " (错误号: " & Err.Number & ")" + +ExitHandler: + ' 清理 + Application.StatusBar = False + Application.ScreenUpdating = True + Application.Calculation = xlCalculationAutomatic + Application.DisplayAlerts = True + + ' 确保关闭BOM库文件 + If Not g_BOMWorkbook Is Nothing Then + On Error Resume Next + g_BOMWorkbook.Close SaveChanges:=False + On Error GoTo 0 + Set g_BOMWorkbook = Nothing + End If +End Function + +' ------------------------------------------------------------------------------ +' 获取输入工作表 +' +' 输入: 无（从活动工作簿查找） +' +' 输出: +' Worksheet - 包含产品型号列的工作表 +' +' 逻辑: +' - 优先查找名为"产品型号"的工作表 +' - 如果不存在，查找包含"型号"或"产品型号"列的工作表 +' ------------------------------------------------------------------------------ +Private Function GetInputWorksheet() As Worksheet + On Error Resume Next + + ' 方法1: 查找名为"产品型号"的工作表 + Set GetInputWorksheet = ActiveWorkbook.Sheets(INPUT_COL_PRODUCT_MODEL) + + If Not GetInputWorksheet Is Nothing Then + Exit Function + End If + + ' 方法2: 查找包含"型号"列的工作表 + Dim ws As Worksheet + For Each ws In ActiveWorkbook.Worksheets + Dim headerCell As Range + Set headerCell = ws.Rows(1).Find(INPUT_COL_MODEL, LookAt:=xlWhole, MatchCase:=False) + + If Not headerCell Is Nothing Then + Set GetInputWorksheet = ws + Exit Function + End If + + Set headerCell = ws.Rows(1).Find(INPUT_COL_PRODUCT_MODEL, LookAt:=xlWhole, MatchCase:=False) + + If Not headerCell Is Nothing Then + Set GetInputWorksheet = ws + Exit Function + End If + Next ws + + Set GetInputWorksheet = Nothing + On Error GoTo 0 +End Function + +' ------------------------------------------------------------------------------ +' 读取输入产品型号 +' +' 输入: +' ws - 输入工作表 +' +' 输出: +' Variant - 二维数组，包含产品型号列表 +' +' 注意: +' - 自动查找"型号"或"产品型号"列 +' - 从第2行开始读取（第1行是表头） +' ------------------------------------------------------------------------------ +Private Function ReadInputModels(ByVal ws As Worksheet) As Variant + On Error GoTo ErrorHandler + + ' 查找型号列 + Dim headerCell As Range + Set headerCell = ws.Rows(1).Find(INPUT_COL_PRODUCT_MODEL, LookAt:=xlPart, MatchCase:=False) + + If headerCell Is Nothing Then + Set headerCell = ws.Rows(1).Find(INPUT_COL_MODEL, LookAt:=xlPart, MatchCase:=False) + End If + + If headerCell Is Nothing Then + ReadInputModels = Empty + Exit Function + End If + + Dim colIdx As Long + colIdx = headerCell.Column + + ' 查找最后一行 + Dim lastRow As Long + lastRow = ws.Cells(ws.Rows.count, colIdx).End(xlUp).row + + If lastRow < 2 Then + ReadInputModels = Empty + Exit Function + End If + + ' 读取数据到数组 + ReadInputModels = ws.Range(ws.Cells(2, colIdx), ws.Cells(lastRow, colIdx)).Value + Exit Function + +ErrorHandler: + ReadInputModels = Empty +End Function + +' ------------------------------------------------------------------------------ +' 处理单个产品型号 +' +' 输入: +' modelString - 产品型号字符串 +' bomWb - BOM库工作簿 +' logger - 错误记录器 +' +' 输出: +' Collection - 提取结果集合 +' 每个元素是一个数组，包含12列数据 +' +' 流程: +' 1. 解析型号，提取参数 +' 2. 匹配所有物料类型 +' 3. 验证部件组合 +' 4. 生成输出行 +' ------------------------------------------------------------------------------ +Private Function ProcessSingleModel( _ + ByVal modelString As String, _ + ByVal bomWb As Workbook, _ + ByVal logger As clsErrorLogger _ +) As Collection + On Error GoTo ErrorHandler + + Dim results As Collection + Set results = New Collection + + ' 步骤1: 解析型号 + Dim params As Object + Set params = M06_ModelParser.ParseProductModel(modelString) + + ' 检查解析是否成功 + If params.count = 0 Then + ' 解析失败，添加错误行 + results.Add GenerateErrorRow(modelString, "型号解析失败：型号格式不正确或缺少必要字段") + Set ProcessSingleModel = results + Exit Function + End If + + ' 步骤2: 匹配所有物料类型 + Dim allMaterials As Collection + Set allMaterials = MatchAllMaterialTypes(params, bomWb, logger) + + ' 步骤3: 验证部件组合 + Dim validation As Object + Set validation = M08_ComponentProcessor.ValidateComponentCombination(allMaterials) + + ' 步骤4: 生成输出行 + Dim remarks As String + remarks = "" + + If Not validation("valid") Then + remarks = validation("message") + End If + + Dim mat As Variant + For Each mat In allMaterials + Dim outputRow As Variant + outputRow = GenerateMaterialRow(modelString, params, mat, remarks) + results.Add outputRow + Next mat + + ' 如果没有匹配到任何物料，添加错误行 + If allMaterials.count = 0 Then + results.Add GenerateErrorRow(modelString, "未匹配到任何物料") + End If + + Set ProcessSingleModel = results + Exit Function + +ErrorHandler: + If Not logger Is Nothing Then + logger.Record 0, "M09.ProcessSingleModel", "SystemError", _ + "处理型号[" & modelString & "]失败: " & Err.Description, "" + End If + + results.Add GenerateErrorRow(modelString, "系统错误: " & Err.Description) + Set ProcessSingleModel = results +End Function + +' ------------------------------------------------------------------------------ +' 匹配所有物料类型 +' +' 输入: +' params - 参数字典 +' bomWb - BOM库工作簿 +' logger - 错误记录器 +' +' 输出: +' Collection - 所有匹配到的物料集合 +' +' 遍历的工作表: +' - 接头 +' - 弹性元件 +' - 机芯 +' - 部件（特殊处理） +' - 边 +' ------------------------------------------------------------------------------ +Private Function MatchAllMaterialTypes( _ + ByVal params As Object, _ + ByVal bomWb As Workbook, _ + ByVal logger As clsErrorLogger _ +) As Collection + On Error GoTo ErrorHandler + + Dim allMaterials As Collection + Set allMaterials = New Collection + + ' 需要遍历的工作表列表 + Dim sheetNames As Variant + sheetNames = Array(BOMLIB_SHEET_JOINT, BOMLIB_SHEET_ELEMENT, _ + BOMLIB_SHEET_MOVEMENT, BOMLIB_SHEET_EDGE) + + Dim i As Long + For i = LBound(sheetNames) To UBound(sheetNames) + Dim sheetName As String + sheetName = sheetNames(i) + + ' 获取工作表 + Dim ws As Worksheet + On Error Resume Next + Set ws = bomWb.Sheets(sheetName) + On Error GoTo ErrorHandler + + If ws Is Nothing Then + ' 工作表不存在，跳过 + GoTo NextSheet + End If + + ' 匹配记录 + Dim matchResult As Object + Set matchResult = M07_BOMMatcher.MatchBOMRecord(ws, params) + + ' 如果匹配成功，提取物料信息 + If matchResult("success") Then + Dim rowNum As Long + rowNum = matchResult("rowNums")(1) + + Dim headerMap As Object + Set headerMap = M07_BOMMatcher.BuildWorksheetHeaderMap(ws) + + Dim materialInfo As Object + Set materialInfo = M07_BOMMatcher.ExtractMaterialInfo(ws, rowNum, headerMap) + + If Not materialInfo Is Nothing Then + allMaterials.Add materialInfo + End If + Else + ' 匹配失败，记录错误（但不中断处理） + logger.Record 0, "M09.MatchAllMaterialTypes", "BOMMatchError", _ + sheetName & " " & matchResult("message"), "" + End If + +NextSheet: + Next i + + ' 特殊处理"部件"工作表 + Dim wsComponent As Worksheet + On Error Resume Next + Set wsComponent = bomWb.Sheets(BOMLIB_SHEET_COMPONENT) + On Error GoTo ErrorHandler + + If Not wsComponent Is Nothing Then + Dim componentMaterials As Collection + Set componentMaterials = M08_ComponentProcessor.ProcessComponentRecord( _ + wsComponent, params, logger) + + Dim compMat As Variant + For Each compMat In componentMaterials + allMaterials.Add compMat + Next compMat + End If + + Set MatchAllMaterialTypes = allMaterials + Exit Function + +ErrorHandler: + If Not logger Is Nothing Then + logger.Record 0, "M09.MatchAllMaterialTypes", "SystemError", _ + "匹配物料类型失败: " & Err.Description, "" + End If + Set MatchAllMaterialTypes = allMaterials +End Function + +' ------------------------------------------------------------------------------ +' 生成单行输出数据 +' +' 输入: +' modelString - 原始产品型号 +' params - 参数字典 +' material - 物料信息字典 +' remarks - 备注信息 +' +' 输出: +' Variant - 包含12列数据的数组 +' +' 列定义: +' 1: 原始产品型号 +' 2: azxs +' 3: bkxs +' 4: gclj +' 5: jycz +' 6: lcfw +' 7: fjgn +' 8: 物料类型 +' 9: 物料名称 +' 10: 物料编码 +' 11: 物料数量 +' 12: 提取备注 +' ------------------------------------------------------------------------------ +Private Function GenerateMaterialRow( _ + ByVal modelString As String, _ + ByVal params As Object, _ + ByVal material As Object, _ + ByVal remarks As String _ +) As Variant + Dim result(1 To 12) As Variant + + ' 第1列: 原始产品型号 + result(1) = modelString + + ' 第2-7列: 参数值 + result(2) = GetParamValue(params, "azxs") + result(3) = GetParamValue(params, "bkxs") + result(4) = GetParamValue(params, "gclj") + result(5) = GetParamValue(params, "jycz") + result(6) = GetParamValue(params, "lcfw") + result(7) = GetParamValue(params, "fjgn") + + ' 第8-11列: 物料信息 + result(8) = GetMaterialValue(material, "materialType") + result(9) = GetMaterialValue(material, "materialName") + result(10) = GetMaterialValue(material, "materialCode") + result(11) = GetMaterialValue(material, "materialQty") + + ' 第12列: 备注 + result(12) = remarks & " " & GetMaterialValue(material, "remarks") + result(12) = Trim(result(12)) + + GenerateMaterialRow = result +End Function + +' ------------------------------------------------------------------------------ +' 生成错误行 +' +' 输入: +' modelString - 原始产品型号 +' errorMessage - 错误消息 +' +' 输出: +' Variant - 包含12列数据的数组（仅型号和备注有值） +' ------------------------------------------------------------------------------ +Private Function GenerateErrorRow( _ + ByVal modelString As String, _ + ByVal errorMessage As String _ +) As Variant + Dim result(1 To 12) As Variant + Dim i As Long + + For i = 1 To 12 + result(i) = "" + Next i + + result(1) = modelString + result(12) = "错误: " & errorMessage + + GenerateErrorRow = result +End Function + +' ------------------------------------------------------------------------------ +' 辅助函数: 从参数字典中获取值 +' ------------------------------------------------------------------------------ +Private Function GetParamValue(ByVal params As Object, ByVal key As String) As Variant + If params.Exists(key) Then + GetParamValue = params(key) + Else + GetParamValue = "" + End If +End Function + +' ------------------------------------------------------------------------------ +' 辅助函数: 从物料字典中获取值 +' ------------------------------------------------------------------------------ +Private Function GetMaterialValue(ByVal material As Object, ByVal key As String) As Variant + If material.Exists(key) Then + GetMaterialValue = material(key) + Else + GetMaterialValue = "" + End If +End Function + +' ------------------------------------------------------------------------------ +' 写入提取结果到工作表 +' +' 输入: +' results - 提取结果集合 +' +' 输出: +' Worksheet - 输出工作表 +' +' 逻辑: +' 1. 创建或清空"BOM提取结果"工作表 +' 2. 写入表头 +' 3. 批量写入数据 +' 4. 格式化工作表 +' ------------------------------------------------------------------------------ +Private Function WriteExtractionResults(ByVal results As Collection) As Worksheet + On Error GoTo ErrorHandler + + Dim ws As Worksheet + + ' 创建或获取工作表 + On Error Resume Next + Set ws = ThisWorkbook.Sheets(OUTPUT_SHEET_NAME) + On Error GoTo ErrorHandler + + If ws Is Nothing Then + Set ws = ThisWorkbook.Worksheets.Add(After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.count)) + ws.Name = OUTPUT_SHEET_NAME + Else + ws.Cells.Clear + End If + + ' 写入表头 + Dim headers As Variant + headers = Array("原始产品型号", "azxs", "bkxs", "gclj", "jycz", "lcfw", "fjgn", _ + "物料类型", "物料名称", "物料编码", "物料数量", "提取备注") + + Dim c As Long + For c = 1 To 12 + ws.Cells(1, c).Value = headers(c - 1) + Next c + + ' 格式化表头 + With ws.Range("A1:L1") + .Font.Bold = True + .Interior.Color = RGB(217, 217, 217) + .HorizontalAlignment = xlCenter + End With + + ' 写入数据 + If results.count > 0 Then + Dim outputArr() As Variant + ReDim outputArr(1 To results.count, 1 To 12) + + Dim i As Long + Dim result As Variant + + For i = 1 To results.count + result = results(i) + + Dim j As Long + For j = 1 To 12 + outputArr(i, j) = result(j) + Next j + Next i + + ws.Range("A2").Resize(results.count, 12).Value = outputArr + + ' 格式化数据区域 + With ws.Range("A2:L" & (results.count + 1)) + .Borders.LineStyle = xlContinuous + .Borders.Weight = xlThin + End With + + ' 如果有错误备注，标红 + For i = 1 To results.count + If Len(CStr(outputArr(i, 12))) > 0 And InStr(CStr(outputArr(i, 12)), "错误") > 0 Then + ws.Cells(i + 1, 12).Interior.Color = RGB(255, 200, 200) + End If + Next i + End If + + ' 自动调整列宽 + ws.Columns.AutoFit + + ' 冻结首行 + ws.Activate + ActiveWindow.FreezePanes = False + ws.Rows(2).Select + ActiveWindow.FreezePanes = True + ws.Cells(1, 1).Select + + Set WriteExtractionResults = ws + Exit Function + +ErrorHandler: + Set WriteExtractionResults = Nothing +End Function + +' ------------------------------------------------------------------------------ +' 打开BOM库文件 +' +' 输入: 无（从当前工作簿目录查找） +' +' 输出: +' Workbook - BOM库工作簿 +' +' 逻辑: +' 1. 获取当前工作簿路径 +' 2. 构建BOM库文件路径 +' 3. 打开BOM库文件（只读模式） +' ------------------------------------------------------------------------------ +Private Function OpenBOMLibrary() As Workbook + On Error GoTo ErrorHandler + + ' 获取当前工作簿路径 + Dim currentPath As String + currentPath = ActiveWorkbook.Path + + ' 构建BOM库文件路径 + Dim bomPath As String + bomPath = currentPath & "\" & BOMLIB_FILENAME + + ' 检查文件是否存在 + Dim fso As Object + Set fso = CreateObject("Scripting.FileSystemObject") + + If Not fso.FileExists(bomPath) Then + Set OpenBOMLibrary = Nothing + Exit Function + End If + + ' 打开BOM库文件（只读） + Set OpenBOMLibrary = Workbooks.Open(bomPath, ReadOnly:=True) + Exit Function + +ErrorHandler: + Set OpenBOMLibrary = Nothing +End Function \ No newline at end of file