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 <noreply@anthropic.com>
This commit is contained in:
Misaka_Company
2026-03-19 14:09:29 +08:00
parent 76a75c9a05
commit d17d7c5864
6 changed files with 274 additions and 24 deletions

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

@@ -20,9 +20,15 @@ Public Sub RunBOMForgeTests()
' 执行数据模型测试 ' 执行数据模型测试
Call Test_cBOMRow Call Test_cBOMRow
' 执行存储库数据层测试 (新增) ' 执行存储库数据层测试
Call Test_BOMRepository Call Test_BOMRepository
' 执行业务策略层测试
Call Test_Processors
' 执行调度中枢联调测试 (新增)
Call Test_Manager_Pipeline
' ---- 输出测试汇总 ---- ' ---- 输出测试汇总 ----
Debug.Print "-----------------------------------------------" Debug.Print "-----------------------------------------------"
Debug.Print "测试汇总: 共 " & (passCount + failCount) & " 个用例" Debug.Print "测试汇总: 共 " & (passCount + failCount) & " 个用例"
@@ -77,9 +83,6 @@ Private Sub Test_ConditionEngine()
End Sub End Sub
' ==============================================================================
' 新增:针对 cBOMRow 对象的单元测试
' ==============================================================================
Private Sub Test_cBOMRow() Private Sub Test_cBOMRow()
Debug.Print "" Debug.Print ""
Debug.Print "========== 2. 开始测试: cBOMRow 数据模型 ==========" Debug.Print "========== 2. 开始测试: cBOMRow 数据模型 =========="
@@ -87,38 +90,28 @@ Private Sub Test_cBOMRow()
Dim bomRow As cBOMRow Dim bomRow As cBOMRow
Set bomRow = New cBOMRow Set bomRow = New cBOMRow
' 测试初始状态:应为 Clean (False)
AssertEqual "初始脏标记测试", "False", CStr(bomRow.IsDirty) AssertEqual "初始脏标记测试", "False", CStr(bomRow.IsDirty)
' 模拟从 Excel 中读取数据 (此时要避开 Property Let 的脏标记触发,但既然封装了,我们就测试 Property Let)
' 实际在 Repository 载入时,载入完毕后会调用 ResetDirtyFlag
bomRow.RowNo = 700 bomRow.RowNo = 700
bomRow.ModuleType = "接头" bomRow.ModuleType = "接头"
bomRow.Code = "01081014361" bomRow.Code = "01081014361"
bomRow.ItemName = "径向高压接头" bomRow.ItemName = "径向高压接头"
bomRow.Condition = "(azxs=A0) AND gclj=Z14" bomRow.Condition = "(azxs=A0) AND gclj=Z14"
' 赋值后应该是脏的
AssertEqual "赋值后脏标记测试", "True", CStr(bomRow.IsDirty) AssertEqual "赋值后脏标记测试", "True", CStr(bomRow.IsDirty)
' 模拟保存完毕重置标记
bomRow.ResetDirtyFlag bomRow.ResetDirtyFlag
AssertEqual "重置后脏标记测试", "False", CStr(bomRow.IsDirty) AssertEqual "重置后脏标记测试", "False", CStr(bomRow.IsDirty)
' 模拟未改变内容的重复赋值 (脏标记不应改变)
bomRow.Condition = "(azxs=A0) AND gclj=Z14" bomRow.Condition = "(azxs=A0) AND gclj=Z14"
AssertEqual "重复赋值脏标记测试", "False", CStr(bomRow.IsDirty) AssertEqual "重复赋值脏标记测试", "False", CStr(bomRow.IsDirty)
' 模拟条件引擎注入新条件 (内容变更,脏标记触发)
bomRow.Condition = "(azxs=A0) AND gclj=Z14 AND (lcfw=M19)" bomRow.Condition = "(azxs=A0) AND gclj=Z14 AND (lcfw=M19)"
AssertEqual "状态变更脏标记测试", "True", CStr(bomRow.IsDirty) AssertEqual "状态变更脏标记测试", "True", CStr(bomRow.IsDirty)
AssertEqual "属性读取测试", "(azxs=A0) AND gclj=Z14 AND (lcfw=M19)", bomRow.Condition AssertEqual "属性读取测试", "(azxs=A0) AND gclj=Z14 AND (lcfw=M19)", bomRow.Condition
End Sub End Sub
' ==============================================================================
' 新增:针对 BOMRepository 存取机制的单元测试 (沙盒模式)
' ==============================================================================
Private Sub Test_BOMRepository() Private Sub Test_BOMRepository()
Debug.Print "" Debug.Print ""
Debug.Print "========== 3. 开始测试: mBOMRepository 数据访问层 ==========" Debug.Print "========== 3. 开始测试: mBOMRepository 数据访问层 =========="
@@ -127,7 +120,6 @@ Private Sub Test_BOMRepository()
Dim wsTemp As Worksheet Dim wsTemp As Worksheet
Set wb = ThisWorkbook Set wb = ThisWorkbook
' 1. 创建沙盒工作表
Application.DisplayAlerts = False Application.DisplayAlerts = False
On Error Resume Next On Error Resume Next
wb.Worksheets("BOMForge_Test_Sandbox").Delete wb.Worksheets("BOMForge_Test_Sandbox").Delete
@@ -135,17 +127,15 @@ Private Sub Test_BOMRepository()
Set wsTemp = wb.Worksheets.Add Set wsTemp = wb.Worksheets.Add
wsTemp.Name = "BOMForge_Test_Sandbox" wsTemp.Name = "BOMForge_Test_Sandbox"
' 2. 模拟初始化表头(第3行)和原始数据(第4,5行)
wsTemp.Cells(3, 1).value = "行号" wsTemp.Cells(3, 1).value = "行号"
wsTemp.Cells(4, 1).value = 10 wsTemp.Cells(4, 1).value = 10
wsTemp.Cells(4, 2).value = "接头" 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, 1).value = 20
wsTemp.Cells(5, 2).value = "盘止钉" wsTemp.Cells(5, 2).value = "盘止钉"
wsTemp.Cells(5, 6).value = "lcfw=M02" wsTemp.Cells(5, 6).value = "lcfw=M02"
' 3. 测试加载功能
Dim bomColl As Collection Dim bomColl As Collection
Set bomColl = LoadAllBOMs(wsTemp) Set bomColl = LoadAllBOMs(wsTemp)
@@ -153,36 +143,136 @@ Private Sub Test_BOMRepository()
AssertEqual "验证读取第一行", "接头", bomColl(1).ModuleType AssertEqual "验证读取第一行", "接头", bomColl(1).ModuleType
AssertEqual "验证加载后脏标记为空", "False", CStr(bomColl(1).IsDirty) AssertEqual "验证加载后脏标记为空", "False", CStr(bomColl(1).IsDirty)
' 4. 测试修改和保存功能 (仅修改第二行)
bomColl(2).Condition = "lcfw=M02 OR lcfw=M19" bomColl(2).Condition = "lcfw=M02 OR lcfw=M19"
SaveAll wsTemp, bomColl SaveAll wsTemp, bomColl
' 验证 Excel 表格内容是否被正确写回
AssertEqual "验证Excel未被错误修改", "lcfw=M01", wsTemp.Cells(4, 6).value AssertEqual "验证Excel未被错误修改", "lcfw=M01", wsTemp.Cells(4, 6).value
AssertEqual "验证Excel正确更新", "lcfw=M02 OR lcfw=M19", wsTemp.Cells(5, 6).value AssertEqual "验证Excel正确更新", "lcfw=M02 OR lcfw=M19", wsTemp.Cells(5, 6).value
AssertEqual "验证保存后脏标记重置", "False", CStr(bomColl(2).IsDirty) AssertEqual "验证保存后脏标记重置", "False", CStr(bomColl(2).IsDirty)
' 5. 测试新增行功能 (基于第一行克隆)
Dim newRow As cBOMRow Dim newRow As cBOMRow
Set newRow = InsertNewBOMRow(bomColl, bomColl(1)) Set newRow = InsertNewBOMRow(bomColl, bomColl(1))
newRow.Condition = "lcfw=M19" newRow.Condition = "lcfw=M19"
SaveAll wsTemp, bomColl SaveAll wsTemp, bomColl
' 验证新增行是否保存到了第6行
AssertEqual "验证新增行集合追加", "3", CStr(bomColl.count) AssertEqual "验证新增行集合追加", "3", CStr(bomColl.count)
AssertEqual "验证新增行Excel保存", "lcfw=M19", wsTemp.Cells(6, 6).value AssertEqual "验证新增行Excel保存", "lcfw=M19", wsTemp.Cells(6, 6).value
AssertEqual "验证新增行Excel映射行号", "6", CStr(newRow.ExcelRowIndex) AssertEqual "验证新增行Excel映射行号", "6", CStr(newRow.ExcelRowIndex)
' 6. 清理沙盒工作表
wsTemp.Delete wsTemp.Delete
Application.DisplayAlerts = True Application.DisplayAlerts = True
End Sub 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) Private Sub AssertEqual(testName As String, expected As String, actual As String)
If expected = actual Then If expected = actual Then