diff --git a/VBA/ClassModules/cBOMRow.cls b/VBA/ClassModules/cBOMRow.cls index adf091d..4d33119 100644 --- a/VBA/ClassModules/cBOMRow.cls +++ b/VBA/ClassModules/cBOMRow.cls @@ -90,23 +90,65 @@ End Property ' ------------------------------------------------------------------------------ ' 其他次要属性的 Get/Let ' ------------------------------------------------------------------------------ -Public Property Get Remark() As String: Remark = pRemark: End Property -Public Property Let Remark(ByVal vNewValue As String): If pRemark <> vNewValue Then pRemark = vNewValue: pIsDirty = True: End Property +Public Property Get Remark() As String + Remark = pRemark +End Property +Public Property Let Remark(ByVal vNewValue As String) + If pRemark <> vNewValue Then + pRemark = vNewValue + pIsDirty = True + End If +End Property -Public Property Get Category() As String: Category = pCategory: End Property -Public Property Let Category(ByVal vNewValue As String): If pCategory <> vNewValue Then pCategory = vNewValue: pIsDirty = True: End Property +Public Property Get Category() As String + Category = pCategory +End Property +Public Property Let Category(ByVal vNewValue As String) + If pCategory <> vNewValue Then + pCategory = vNewValue + pIsDirty = True + End If +End Property -Public Property Get ParentCategory() As String: ParentCategory = pParentCategory: End Property -Public Property Let ParentCategory(ByVal vNewValue As String): If pParentCategory <> vNewValue Then pParentCategory = vNewValue: pIsDirty = True: End Property +Public Property Get ParentCategory() As String + ParentCategory = pParentCategory +End Property +Public Property Let ParentCategory(ByVal vNewValue As String) + If pParentCategory <> vNewValue Then + pParentCategory = vNewValue + pIsDirty = True + End If +End Property -Public Property Get CategoryCondition() As String: CategoryCondition = pCategoryCondition: End Property -Public Property Let CategoryCondition(ByVal vNewValue As String): If pCategoryCondition <> vNewValue Then pCategoryCondition = vNewValue: pIsDirty = True: End Property +Public Property Get CategoryCondition() As String + CategoryCondition = pCategoryCondition +End Property +Public Property Let CategoryCondition(ByVal vNewValue As String) + If pCategoryCondition <> vNewValue Then + pCategoryCondition = vNewValue + pIsDirty = True + End If +End Property -Public Property Get Code66() As String: Code66 = pCode66: End Property -Public Property Let Code66(ByVal vNewValue As String): If pCode66 <> vNewValue Then pCode66 = vNewValue: pIsDirty = True: End Property +Public Property Get Code66() As String + Code66 = pCode66 +End Property +Public Property Let Code66(ByVal vNewValue As String) + If pCode66 <> vNewValue Then + pCode66 = vNewValue + pIsDirty = True + End If +End Property -Public Property Get BIPBaseRowNo() As String: BIPBaseRowNo = pBIPBaseRowNo: End Property -Public Property Let BIPBaseRowNo(ByVal vNewValue As String): If pBIPBaseRowNo <> vNewValue Then pBIPBaseRowNo = vNewValue: pIsDirty = True: End Property +Public Property Get BIPBaseRowNo() As String + BIPBaseRowNo = pBIPBaseRowNo +End Property +Public Property Let BIPBaseRowNo(ByVal vNewValue As String) + If pBIPBaseRowNo <> vNewValue Then + pBIPBaseRowNo = vNewValue + pIsDirty = True + End If +End Property ' ------------------------------------------------------------------------------ ' 状态追踪：只读的 IsDirty 和重置方法 diff --git a/VBA/Modules/mBOMRepository.bas b/VBA/Modules/mBOMRepository.bas new file mode 100644 index 0000000..ee3d30c --- /dev/null +++ b/VBA/Modules/mBOMRepository.bas @@ -0,0 +1,127 @@ +' ============================================================================== +' 模块名称: mBOMRepository +' 模块类别: 标准模块 (Standard Module) +' 所属项目: BOMForge +' 模块职责: 负责 Excel 表格与 cBOMRow 内存对象之间的双向数据交互 +' ============================================================================== +Option Explicit + +' ------------------------------------------------------------------------------ +' 函数名称: LoadAllBOMs +' 函数功能: 将工作表中的 BOM 数据逐行加载为 cBOMRow 对象的集合 +' 参数说明: ws - 目标工作表对象 +' ------------------------------------------------------------------------------ +Public Function LoadAllBOMs(ws As Worksheet) As Collection + Dim coll As New Collection + Dim lastRow As Long + Dim i As Long + Dim rowObj As cBOMRow + + ' 获取 A 列最后一行 (假设 A 列总是有数据的，如行号) + lastRow = ws.Cells(ws.Rows.count, "A").End(xlUp).row + + ' 根据业务说明，表头在第3行，数据从第4行开始 + If lastRow < 4 Then + Set LoadAllBOMs = coll + Exit Function + End If + + For i = 4 To lastRow + Set rowObj = New cBOMRow + + ' 映射 Excel 列到对象属性 + rowObj.ExcelRowIndex = i + rowObj.RowNo = Val(ws.Cells(i, 1).value) + rowObj.ModuleType = Trim(ws.Cells(i, 2).value) + rowObj.Code = Trim(ws.Cells(i, 3).value) + rowObj.ItemName = Trim(ws.Cells(i, 4).value) + rowObj.Quantity = Val(ws.Cells(i, 5).value) + rowObj.Condition = Trim(ws.Cells(i, 6).value) + rowObj.Remark = Trim(ws.Cells(i, 7).value) + rowObj.Category = Trim(ws.Cells(i, 8).value) + rowObj.ParentCategory = Trim(ws.Cells(i, 9).value) + rowObj.CategoryCondition = Trim(ws.Cells(i, 10).value) + rowObj.Code66 = Trim(ws.Cells(i, 11).value) + rowObj.BIPBaseRowNo = Trim(ws.Cells(i, 12).value) + + ' 【关键】刚从 Excel 读取的数据是原生态的，重置脏标记 + rowObj.ResetDirtyFlag + + coll.Add rowObj + Next i + + Set LoadAllBOMs = coll +End Function + +' ------------------------------------------------------------------------------ +' 函数名称: SaveAll +' 函数功能: 遍历集合，仅将发生改变 (IsDirty = True) 的对象写回 Excel +' 参数说明: ws - 目标工作表对象, bomCollection - 内存对象集合 +' ------------------------------------------------------------------------------ +Public Sub SaveAll(ws As Worksheet, bomCollection As Collection) + Dim rowObj As cBOMRow + Dim r As Long + + For Each rowObj In bomCollection + ' 【性能核心】只写回被业务策略修改过的行 + If rowObj.IsDirty Then + r = rowObj.ExcelRowIndex + + ' 如果是新增行，ExcelRowIndex 可能为空或需要重新计算 + If r <= 0 Then + r = ws.Cells(ws.Rows.count, "A").End(xlUp).row + 1 + rowObj.ExcelRowIndex = r + End If + + ' 将属性写回对应的列 + ws.Cells(r, 1).value = rowObj.RowNo + ws.Cells(r, 2).value = rowObj.ModuleType + ws.Cells(r, 3).value = rowObj.Code + ws.Cells(r, 4).value = rowObj.ItemName + ws.Cells(r, 5).value = rowObj.Quantity + ws.Cells(r, 6).value = rowObj.Condition + ws.Cells(r, 7).value = rowObj.Remark + ws.Cells(r, 8).value = rowObj.Category + ws.Cells(r, 9).value = rowObj.ParentCategory + ws.Cells(r, 10).value = rowObj.CategoryCondition + ws.Cells(r, 11).value = rowObj.Code66 + ws.Cells(r, 12).value = rowObj.BIPBaseRowNo + + ' 保存完毕，重置脏标记 + rowObj.ResetDirtyFlag + End If + Next rowObj +End Sub + +' ------------------------------------------------------------------------------ +' 函数名称: InsertNewBOMRow +' 函数功能: 基于现有行克隆出一个新行对象，用于弹性元件等需要全新规格新增的场景 +' ------------------------------------------------------------------------------ +Public Function InsertNewBOMRow(bomCollection As Collection, copyFromObj As cBOMRow) As cBOMRow + Dim newObj As New cBOMRow + + ' 设置为 0 意味着在 SaveAll 时，它会自动追加到 Excel 的最后一行 + newObj.ExcelRowIndex = 0 + + ' 属性克隆 + newObj.RowNo = copyFromObj.RowNo ' 这里的行号往往需要外部策略重新编排，先克隆 + newObj.ModuleType = copyFromObj.ModuleType + newObj.Code = copyFromObj.Code ' 同样等待外部策略分配新代码 + newObj.ItemName = copyFromObj.ItemName + newObj.Quantity = copyFromObj.Quantity + newObj.Condition = copyFromObj.Condition + newObj.Remark = copyFromObj.Remark + newObj.Category = copyFromObj.Category + newObj.ParentCategory = copyFromObj.ParentCategory + newObj.CategoryCondition = copyFromObj.CategoryCondition + newObj.Code66 = copyFromObj.Code66 + newObj.BIPBaseRowNo = copyFromObj.BIPBaseRowNo + + ' 强制触发一下脏标记，确保这个新对象会被 SaveAll 捕获写进 Excel + ' 由于 Let 属性判断 <> 才会触发，我们采用一个小技巧 + newObj.Code = newObj.Code & "_TEMP" + newObj.Code = copyFromObj.Code + + bomCollection.Add newObj + Set InsertNewBOMRow = newObj +End Function \ No newline at end of file diff --git a/VBA/Modules/mTestEngine.bas b/VBA/Modules/mTestEngine.bas index 0b14d4e..cef26b6 100644 --- a/VBA/Modules/mTestEngine.bas +++ b/VBA/Modules/mTestEngine.bas @@ -17,9 +17,12 @@ Public Sub RunBOMForgeTests() ' 执行条件引擎测试 Call Test_ConditionEngine - ' 执行数据模型测试 (新增) + ' 执行数据模型测试 Call Test_cBOMRow + ' 执行存储库数据层测试 (新增) + Call Test_BOMRepository + ' ---- 输出测试汇总 ---- Debug.Print "-----------------------------------------------" Debug.Print "测试汇总: 共 " & (passCount + failCount) & " 个用例" @@ -113,6 +116,70 @@ Private Sub Test_cBOMRow() End Sub +' ============================================================================== +' 新增：针对 BOMRepository 存取机制的单元测试 (沙盒模式) +' ============================================================================== +Private Sub Test_BOMRepository() + Debug.Print "" + Debug.Print "========== 3. 开始测试: mBOMRepository 数据访问层 ==========" + + Dim wb As Workbook + Dim wsTemp As Worksheet + Set wb = ThisWorkbook + + ' 1. 创建沙盒工作表 + Application.DisplayAlerts = False + On Error Resume Next + wb.Worksheets("BOMForge_Test_Sandbox").Delete + On Error GoTo 0 + 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(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) + + AssertEqual "加载集合数量", "2", CStr(bomColl.count) + 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 + ' ============================================================================== ' 内部辅助方法：断言测试结果 ' 将期望值与实际值进行比对，并输出标准化的日志信息