feat: implement BOM auto-extraction system
All checks were successful
NTFY Notification / notify (push) Successful in 11s
All checks were successful
NTFY Notification / notify (push) Successful in 11s
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 <noreply@anthropic.com>
This commit is contained in:
Misaka_Company
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
412
VBA_BOMConverter/Modules/M06B_TestRunner.bas
Normal file
412
VBA_BOMConverter/Modules/M06B_TestRunner.bas
Normal file
@@ -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
|
||||
299
VBA_BOMConverter/Modules/M06_ModelParser.bas
Normal file
299
VBA_BOMConverter/Modules/M06_ModelParser.bas
Normal file
@@ -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
|
||||
434
VBA_BOMConverter/Modules/M07_BOMMatcher.bas
Normal file
434
VBA_BOMConverter/Modules/M07_BOMMatcher.bas
Normal file
@@ -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
|
||||
478
VBA_BOMConverter/Modules/M08_ComponentProcessor.bas
Normal file
478
VBA_BOMConverter/Modules/M08_ComponentProcessor.bas
Normal file
@@ -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
|
||||
716
VBA_BOMConverter/Modules/M09_BOMExtractor.bas
Normal file
716
VBA_BOMConverter/Modules/M09_BOMExtractor.bas
Normal file
@@ -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
|
||||
Reference in New Issue
Block a user