From d17d7c5864e2d8da76b4cb1a7a75937cdbf71c5d Mon Sep 17 00:00:00 2001 From: Misaka_Company Date: Thu, 19 Mar 2026 14:09:29 +0800 Subject: [PATCH] Add strategy pattern architecture for BOM module processing - Add IModuleProcessor interface defining the processor contract - Implement cProcessor_AppendOnly strategy for modifying existing BOM rows - Implement cProcessor_CloneNew strategy for creating new BOM rows - Add mProcessorFactory module for creating processor instances - Add mSpecAdditionManager module for coordinating spec addition operations - Enhance test suite with business logic layer and pipeline integration tests This implements the Strategy pattern to allow flexible BOM modification behaviors while maintaining clean separation of concerns. Co-Authored-By: Claude Sonnet 4.6 --- VBA/ClassModules/IModuleProcessor.cls | 16 +++ VBA/ClassModules/cProcessor_AppendOnly.cls | 28 +++++ VBA/ClassModules/cProcessor_CloneNew.cls | 39 ++++++ VBA/Modules/mProcessorFactory.bas | 27 ++++ VBA/Modules/mSpecAdditionManager.bas | 50 ++++++++ VBA/Modules/mTestEngine.bas | 138 +++++++++++++++++---- 6 files changed, 274 insertions(+), 24 deletions(-) create mode 100644 VBA/ClassModules/IModuleProcessor.cls create mode 100644 VBA/ClassModules/cProcessor_AppendOnly.cls create mode 100644 VBA/ClassModules/cProcessor_CloneNew.cls create mode 100644 VBA/Modules/mProcessorFactory.bas create mode 100644 VBA/Modules/mSpecAdditionManager.bas diff --git a/VBA/ClassModules/IModuleProcessor.cls b/VBA/ClassModules/IModuleProcessor.cls new file mode 100644 index 0000000..b3af3f4 --- /dev/null +++ b/VBA/ClassModules/IModuleProcessor.cls @@ -0,0 +1,16 @@ +' ============================================================================== +' 模块名称: IModuleProcessor +' 模块类别: 类模块 (用作接口 Interface) +' 模块职责: 定义统一的业务处理接口，基于UI用户选择的物料名称进行精准处理 +' ============================================================================== +Option Explicit + +' 方法名: ProcessSpec +' allBOMs: 包含所有物料信息的集合 (库里的所有数据) +' targetItemName: 要被处理的物料的名称字段 (瞄准镜) +' paramName: 参数名(如 lcfw) +' newValue: 新规格代码(如 M19) +' engine: 条件注入引擎实例 +Public Sub ProcessSpec(ByRef allBOMs As Collection, ByVal targetItemName As String, ByVal paramName As String, ByVal newValue As String, ByRef engine As cConditionEngine) + ' 接口中不写任何实现代码 +End Sub \ No newline at end of file diff --git a/VBA/ClassModules/cProcessor_AppendOnly.cls b/VBA/ClassModules/cProcessor_AppendOnly.cls new file mode 100644 index 0000000..387865f --- /dev/null +++ b/VBA/ClassModules/cProcessor_AppendOnly.cls @@ -0,0 +1,28 @@ +' ============================================================================== +' 模块名称: cProcessor_AppendOnly +' 模块类别: 类模块 +' 模块职责: 通用追加策略。适用于接头、封口片、机芯、盘止钉等。 +' 逻辑描述: 遍历所有数据，凡是名称与目标匹配的变种，一律注入新条件。 +' ============================================================================== +Option Explicit +Implements IModuleProcessor + +Private Sub IModuleProcessor_ProcessSpec( _ + ByRef allBOMs As Collection, _ + ByVal targetItemName As String, _ + ByVal paramName As String, _ + ByVal newValue As String, _ + ByRef engine As cConditionEngine) + + Dim rowObj As cBOMRow + + ' 遍历整个库 + For Each rowObj In allBOMs + ' 只要名称完全匹配 (忽略大小写进行比对) + If StrComp(rowObj.ItemName, targetItemName, vbTextCompare) = 0 Then + ' 利用引擎进行外科手术级别的追加 + rowObj.Condition = engine.InjectOr(rowObj.Condition, paramName, newValue) + End If + Next rowObj + +End Sub \ No newline at end of file diff --git a/VBA/ClassModules/cProcessor_CloneNew.cls b/VBA/ClassModules/cProcessor_CloneNew.cls new file mode 100644 index 0000000..05dc275 --- /dev/null +++ b/VBA/ClassModules/cProcessor_CloneNew.cls @@ -0,0 +1,39 @@ +' ============================================================================== +' 模块名称: cProcessor_CloneNew +' 模块类别: 类模块 +' 模块职责: 通用克隆新增策略。适用于弹性元件等需要完全独立成行的规格。 +' 逻辑描述: 找到第一个匹配的母版行，克隆它并赋予纯粹的新规格条件。 +' ============================================================================== +Option Explicit +Implements IModuleProcessor + +Private Sub IModuleProcessor_ProcessSpec( _ + ByRef allBOMs As Collection, _ + ByVal targetItemName As String, _ + ByVal paramName As String, _ + ByVal newValue As String, _ + ByRef engine As cConditionEngine) + + Dim rowObj As cBOMRow + Dim templateRow As cBOMRow + Set templateRow = Nothing + + ' 1. 寻找母版 (找到同名的第一条记录即可) + For Each rowObj In allBOMs + If StrComp(rowObj.ItemName, targetItemName, vbTextCompare) = 0 Then + Set templateRow = rowObj + Exit For + End If + Next rowObj + + ' 2. 如果找到了母版，进行克隆 + If Not templateRow Is Nothing Then + Dim newRow As cBOMRow + ' 调用数据访问层的克隆方法，它会自动把新对象加入到 allBOMs 集合中 + Set newRow = mBOMRepository.InsertNewBOMRow(allBOMs, templateRow) + + ' 新行的选择条件不再是追加，而是直接等于新规格 (例如：lcfw=M19) + newRow.Condition = paramName & "=" & newValue + End If + +End Sub \ No newline at end of file diff --git a/VBA/Modules/mProcessorFactory.bas b/VBA/Modules/mProcessorFactory.bas new file mode 100644 index 0000000..34217a0 --- /dev/null +++ b/VBA/Modules/mProcessorFactory.bas @@ -0,0 +1,27 @@ +' ============================================================================== +' 模块名称: mProcessorFactory +' 模块类别: 标准模块 (Standard Module) +' 模块职责: 负责根据传入的策略类型标识，实例化并返回对应的业务策略对象 +' ============================================================================== +Option Explicit + +' ------------------------------------------------------------------------------ +' 函数名称: GetProcessor +' 函数功能: 根据策略别名，返回对应的 IModuleProcessor 实现类 +' 参数说明: strategyType - 策略标识 (例如 "APPEND" 或 "CLONE") +' ------------------------------------------------------------------------------ +Public Function GetProcessor(ByVal strategyType As String) As IModuleProcessor + Select Case UCase(Trim(strategyType)) + Case "APPEND" + ' 返回追加策略实例 + Set GetProcessor = New cProcessor_AppendOnly + + Case "CLONE" + ' 返回克隆新增策略实例 + Set GetProcessor = New cProcessor_CloneNew + + Case Else + ' 如果传入了未知的策略，主动抛出异常阻断运行 + Err.Raise vbObjectError + 513, "ProcessorFactory", "未知的业务处理策略: " & strategyType + End Select +End Function \ No newline at end of file diff --git a/VBA/Modules/mSpecAdditionManager.bas b/VBA/Modules/mSpecAdditionManager.bas new file mode 100644 index 0000000..fe6694a --- /dev/null +++ b/VBA/Modules/mSpecAdditionManager.bas @@ -0,0 +1,50 @@ +' ============================================================================== +' 模块名称: mSpecAdditionManager +' 模块类别: 标准模块 (Standard Module) +' 模块职责: 整个架构的主控大脑，负责协调各层组件，完成端到端的数据处理流水线 +' ============================================================================== +Option Explicit + +' ------------------------------------------------------------------------------ +' 过程名称: ExecuteAddition +' 过程功能: 执行完整的新增规格流水线 +' 参数说明: +' ws - 目标工作表对象 +' targetItemName - 用户瞄准的物料名称 (如 "径向高压接头") +' paramName - 要修改的参数名 (如 "lcfw") +' newValue - 新增的规格值 (如 "M19") +' strategyType - UI选择的执行策略 (如 "APPEND" 或 "CLONE") +' ------------------------------------------------------------------------------ +Public Sub ExecuteAddition( _ + ByVal ws As Worksheet, _ + ByVal targetItemName As String, _ + ByVal paramName As String, _ + ByVal newValue As String, _ + ByVal strategyType As String) + + Dim engine As cConditionEngine + Dim bomCollection As Collection + Dim processor As IModuleProcessor + + ' [步骤 1] 初始化核心手术刀引擎 + Set engine = New cConditionEngine + + ' [步骤 2] 通过数据层将 Excel 读入内存变为对象集合 + Set bomCollection = mBOMRepository.LoadAllBOMs(ws) + + ' [步骤 3] 从工厂获取用户指定的策略 + Set processor = mProcessorFactory.GetProcessor(strategyType) + + ' [步骤 4] 将数据集合与目标扔给策略对象执行 + ' 提示：所有的脏标记 (IsDirty) 会在这一步由对象自己触发记录 + processor.ProcessSpec bomCollection, targetItemName, paramName, newValue, engine + + ' [步骤 5] 将修改过的数据 (IsDirty=True) 批量写回 Excel + mBOMRepository.SaveAll ws, bomCollection + + ' 释放资源 (VBA 虽然有垃圾回收，但良好习惯可以防止 Excel 卡死) + Set processor = Nothing + Set bomCollection = Nothing + Set engine = Nothing + +End Sub \ No newline at end of file diff --git a/VBA/Modules/mTestEngine.bas b/VBA/Modules/mTestEngine.bas index cef26b6..31c6a80 100644 --- a/VBA/Modules/mTestEngine.bas +++ b/VBA/Modules/mTestEngine.bas @@ -20,9 +20,15 @@ Public Sub RunBOMForgeTests() ' 执行数据模型测试 Call Test_cBOMRow - ' 执行存储库数据层测试 (新增) + ' 执行存储库数据层测试 Call Test_BOMRepository + ' 执行业务策略层测试 + Call Test_Processors + + ' 执行调度中枢联调测试 (新增) + Call Test_Manager_Pipeline + ' ---- 输出测试汇总 ---- Debug.Print "-----------------------------------------------" Debug.Print "测试汇总: 共 " & (passCount + failCount) & " 个用例" @@ -77,9 +83,6 @@ Private Sub Test_ConditionEngine() End Sub -' ============================================================================== -' 新增：针对 cBOMRow 对象的单元测试 -' ============================================================================== Private Sub Test_cBOMRow() Debug.Print "" Debug.Print "========== 2. 开始测试: cBOMRow 数据模型 ==========" @@ -87,38 +90,28 @@ Private Sub Test_cBOMRow() Dim bomRow As cBOMRow Set bomRow = New cBOMRow - ' 测试初始状态：应为 Clean (False) AssertEqual "初始脏标记测试", "False", CStr(bomRow.IsDirty) - ' 模拟从 Excel 中读取数据 (此时要避开 Property Let 的脏标记触发，但既然封装了，我们就测试 Property Let) - ' 实际在 Repository 载入时，载入完毕后会调用 ResetDirtyFlag bomRow.RowNo = 700 bomRow.ModuleType = "接头" bomRow.Code = "01081014361" bomRow.ItemName = "径向高压接头" bomRow.Condition = "(azxs=A0) AND gclj=Z14" - ' 赋值后应该是脏的 AssertEqual "赋值后脏标记测试", "True", CStr(bomRow.IsDirty) - ' 模拟保存完毕重置标记 bomRow.ResetDirtyFlag AssertEqual "重置后脏标记测试", "False", CStr(bomRow.IsDirty) - ' 模拟未改变内容的重复赋值 (脏标记不应改变) bomRow.Condition = "(azxs=A0) AND gclj=Z14" AssertEqual "重复赋值脏标记测试", "False", CStr(bomRow.IsDirty) - ' 模拟条件引擎注入新条件 (内容变更，脏标记触发) bomRow.Condition = "(azxs=A0) AND gclj=Z14 AND (lcfw=M19)" AssertEqual "状态变更脏标记测试", "True", CStr(bomRow.IsDirty) AssertEqual "属性读取测试", "(azxs=A0) AND gclj=Z14 AND (lcfw=M19)", bomRow.Condition End Sub -' ============================================================================== -' 新增：针对 BOMRepository 存取机制的单元测试 (沙盒模式) -' ============================================================================== Private Sub Test_BOMRepository() Debug.Print "" Debug.Print "========== 3. 开始测试: mBOMRepository 数据访问层 ==========" @@ -127,7 +120,6 @@ Private Sub Test_BOMRepository() Dim wsTemp As Worksheet Set wb = ThisWorkbook - ' 1. 创建沙盒工作表 Application.DisplayAlerts = False On Error Resume Next wb.Worksheets("BOMForge_Test_Sandbox").Delete @@ -135,17 +127,15 @@ Private Sub Test_BOMRepository() Set wsTemp = wb.Worksheets.Add wsTemp.Name = "BOMForge_Test_Sandbox" - ' 2. 模拟初始化表头(第3行)和原始数据(第4,5行) wsTemp.Cells(3, 1).value = "行号" wsTemp.Cells(4, 1).value = 10 wsTemp.Cells(4, 2).value = "接头" - wsTemp.Cells(4, 6).value = "lcfw=M01" ' 选择条件 + wsTemp.Cells(4, 6).value = "lcfw=M01" wsTemp.Cells(5, 1).value = 20 wsTemp.Cells(5, 2).value = "盘止钉" wsTemp.Cells(5, 6).value = "lcfw=M02" - ' 3. 测试加载功能 Dim bomColl As Collection Set bomColl = LoadAllBOMs(wsTemp) @@ -153,36 +143,136 @@ Private Sub Test_BOMRepository() AssertEqual "验证读取第一行", "接头", bomColl(1).ModuleType AssertEqual "验证加载后脏标记为空", "False", CStr(bomColl(1).IsDirty) - ' 4. 测试修改和保存功能 (仅修改第二行) bomColl(2).Condition = "lcfw=M02 OR lcfw=M19" SaveAll wsTemp, bomColl - ' 验证 Excel 表格内容是否被正确写回 AssertEqual "验证Excel未被错误修改", "lcfw=M01", wsTemp.Cells(4, 6).value AssertEqual "验证Excel正确更新", "lcfw=M02 OR lcfw=M19", wsTemp.Cells(5, 6).value AssertEqual "验证保存后脏标记重置", "False", CStr(bomColl(2).IsDirty) - ' 5. 测试新增行功能 (基于第一行克隆) Dim newRow As cBOMRow Set newRow = InsertNewBOMRow(bomColl, bomColl(1)) newRow.Condition = "lcfw=M19" SaveAll wsTemp, bomColl - ' 验证新增行是否保存到了第6行 AssertEqual "验证新增行集合追加", "3", CStr(bomColl.count) AssertEqual "验证新增行Excel保存", "lcfw=M19", wsTemp.Cells(6, 6).value AssertEqual "验证新增行Excel映射行号", "6", CStr(newRow.ExcelRowIndex) - ' 6. 清理沙盒工作表 wsTemp.Delete Application.DisplayAlerts = True End Sub +Private Sub Test_Processors() + Debug.Print "" + Debug.Print "========== 4. 开始测试: 业务策略层 (Strategy) 新架构 ==========" + + Dim engine As cConditionEngine + Set engine = New cConditionEngine + + Dim paramName As String: paramName = "lcfw" + Dim newValue As String: newValue = "M19" + + Dim mockBOMs As New Collection + Dim row1 As New cBOMRow, row2 As New cBOMRow, row3 As New cBOMRow + + row1.ItemName = "径向高压接头" + row1.Condition = "lcfw=M12" + mockBOMs.Add row1 + + row2.ItemName = "径向高压接头" + row2.Condition = "lcfw=M13" + mockBOMs.Add row2 + + row3.ItemName = "弹簧管" + row3.Condition = "lcfw=M01 AND gclj!=M20" + mockBOMs.Add row3 + + Dim strategyAppend As IModuleProcessor + Set strategyAppend = New cProcessor_AppendOnly + + strategyAppend.ProcessSpec mockBOMs, "径向高压接头", paramName, newValue, engine + + AssertEqual "追加策略_变种1被更新", "lcfw=M12 OR lcfw=M19", row1.Condition + AssertEqual "追加策略_变种2被更新", "lcfw=M13 OR lcfw=M19", row2.Condition + AssertEqual "追加策略_不影响其他物料", "lcfw=M01 AND gclj!=M20", row3.Condition + + Dim strategyClone As IModuleProcessor + Set strategyClone = New cProcessor_CloneNew + + Dim initialCount As Integer + initialCount = mockBOMs.count + + strategyClone.ProcessSpec mockBOMs, "弹簧管", paramName, newValue, engine + + AssertEqual "克隆策略_集合数量增加", CStr(initialCount + 1), CStr(mockBOMs.count) + AssertEqual "克隆策略_新行条件纯粹准确", "lcfw=M19", mockBOMs(mockBOMs.count).Condition + AssertEqual "克隆策略_新行名称继承", "弹簧管", mockBOMs(mockBOMs.count).ItemName + +End Sub + +' ============================================================================== +' 新增：端到端流水线集成测试 +' 验证 Manager 能否将表数据读取、调用策略并正确写回物理单元格 +' ============================================================================== +Private Sub Test_Manager_Pipeline() + Debug.Print "" + Debug.Print "========== 5. 开始测试: 调度中枢集成测试 (Pipeline) ==========" + + Dim wb As Workbook + Dim wsTemp As Worksheet + Set wb = ThisWorkbook + + ' 创建沙盒工作表并准备初始数据 + Application.DisplayAlerts = False + On Error Resume Next + wb.Worksheets("BOMForge_Test_Pipeline").Delete + On Error GoTo 0 + Set wsTemp = wb.Worksheets.Add + wsTemp.Name = "BOMForge_Test_Pipeline" + + ' 表头及数据 + wsTemp.Cells(3, 1).value = "行号" + + ' 第4行：目标物料1 + wsTemp.Cells(4, 1).value = 700 + wsTemp.Cells(4, 4).value = "径向高压接头" ' ItemName + wsTemp.Cells(4, 6).value = "lcfw=M12" ' Condition + + ' 第5行：目标物料2 (变种) + wsTemp.Cells(5, 1).value = 710 + wsTemp.Cells(5, 4).value = "径向高压接头" + wsTemp.Cells(5, 6).value = "lcfw=M13" + + ' 第6行：非目标物料 + wsTemp.Cells(6, 1).value = 800 + wsTemp.Cells(6, 4).value = "弹簧管" + wsTemp.Cells(6, 6).value = "lcfw=M01" + + ' ===== 执行调度中枢的追加流水线 ===== + mSpecAdditionManager.ExecuteAddition wsTemp, "径向高压接头", "lcfw", "M19", "APPEND" + + ' 断言 Excel 表格的结果 + AssertEqual "集成测试_追加_目标行1已被更新", "lcfw=M12 OR lcfw=M19", wsTemp.Cells(4, 6).value + AssertEqual "集成测试_追加_目标行2已被更新", "lcfw=M13 OR lcfw=M19", wsTemp.Cells(5, 6).value + AssertEqual "集成测试_追加_非目标行保持不变", "lcfw=M01", wsTemp.Cells(6, 6).value + + ' ===== 执行调度中枢的克隆新增流水线 ===== + mSpecAdditionManager.ExecuteAddition wsTemp, "弹簧管", "lcfw", "M19", "CLONE" + + ' 断言 Excel 表格的结果 (克隆的行应追加在末尾) + AssertEqual "集成测试_克隆_原行保持不变", "lcfw=M01", wsTemp.Cells(6, 6).value + AssertEqual "集成测试_克隆_新增行名称", "弹簧管", wsTemp.Cells(7, 4).value + AssertEqual "集成测试_克隆_新增行条件", "lcfw=M19", wsTemp.Cells(7, 6).value + + wsTemp.Delete + Application.DisplayAlerts = True +End Sub + ' ============================================================================== ' 内部辅助方法：断言测试结果 -' 将期望值与实际值进行比对，并输出标准化的日志信息 ' ============================================================================== Private Sub AssertEqual(testName As String, expected As String, actual As String) If expected = actual Then