Add VBA source code modules
Added VBA project structure including: - Class modules for BOM row and condition engine - Test engine module Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
121
VBA/ClassModules/cBOMRow.cls
Normal file
121
VBA/ClassModules/cBOMRow.cls
Normal file
@@ -0,0 +1,121 @@
|
||||
' ==============================================================================
|
||||
' 模块名称: cBOMRow
|
||||
' 模块类别: 类模块 (Class Module)
|
||||
' 所属项目: BOMForge
|
||||
' 模块职责: 封装单行 BOM 数据,提供属性访问,并内置状态跟踪 (脏标记) 机制
|
||||
' ==============================================================================
|
||||
Option Explicit
|
||||
|
||||
' 内部变量:映射 Excel 数据列
|
||||
Private pExcelRowIndex As Long ' 记录该对象对应 Excel 表中的物理行号,保存时定位用
|
||||
Private pRowNo As Long ' 行号 (如 10, 20)
|
||||
Private pModuleType As String ' 模块 (如 表壳, 罩壳, 接头)
|
||||
Private pCode As String ' 代号
|
||||
Private pItemName As String ' 名称 (使用 ItemName 避免与内部 Name 关键字冲突)
|
||||
Private pQuantity As Double ' 数量
|
||||
Private pCondition As String ' 选择条件 (核心修改字段)
|
||||
Private pRemark As String ' 备注
|
||||
Private pCategory As String ' 类别
|
||||
Private pParentCategory As String ' 上层类别
|
||||
Private pCategoryCondition As String ' 类别选用条件
|
||||
Private pCode66 As String ' 66代码
|
||||
Private pBIPBaseRowNo As String ' BIP行号基数
|
||||
|
||||
' 内部变量:状态追踪
|
||||
Private pIsDirty As Boolean ' 脏标记:True 表示对象数据被修改过,需要写回 Excel
|
||||
|
||||
' 初始化对象时,默认状态为干净 (未修改)
|
||||
Private Sub Class_Initialize()
|
||||
pIsDirty = False
|
||||
End Sub
|
||||
|
||||
' ------------------------------------------------------------------------------
|
||||
' 属性: ExcelRowIndex (物理行号)
|
||||
' ------------------------------------------------------------------------------
|
||||
Public Property Get ExcelRowIndex() As Long: ExcelRowIndex = pExcelRowIndex: End Property
|
||||
Public Property Let ExcelRowIndex(ByVal vNewValue As Long): pExcelRowIndex = vNewValue: End Property
|
||||
|
||||
' ------------------------------------------------------------------------------
|
||||
' 属性: RowNo (BOM行号)
|
||||
' ------------------------------------------------------------------------------
|
||||
Public Property Get RowNo() As Long: RowNo = pRowNo: End Property
|
||||
Public Property Let RowNo(ByVal vNewValue As Long)
|
||||
If pRowNo <> vNewValue Then pRowNo = vNewValue: pIsDirty = True
|
||||
End Property
|
||||
|
||||
' ------------------------------------------------------------------------------
|
||||
' 属性: ModuleType (模块)
|
||||
' ------------------------------------------------------------------------------
|
||||
Public Property Get ModuleType() As String: ModuleType = pModuleType: End Property
|
||||
Public Property Let ModuleType(ByVal vNewValue As String)
|
||||
If pModuleType <> vNewValue Then pModuleType = vNewValue: pIsDirty = True
|
||||
End Property
|
||||
|
||||
' ------------------------------------------------------------------------------
|
||||
' 属性: Code (代号)
|
||||
' ------------------------------------------------------------------------------
|
||||
Public Property Get Code() As String: Code = pCode: End Property
|
||||
Public Property Let Code(ByVal vNewValue As String)
|
||||
If pCode <> vNewValue Then pCode = vNewValue: pIsDirty = True
|
||||
End Property
|
||||
|
||||
' ------------------------------------------------------------------------------
|
||||
' 属性: ItemName (名称)
|
||||
' ------------------------------------------------------------------------------
|
||||
Public Property Get ItemName() As String: ItemName = pItemName: End Property
|
||||
Public Property Let ItemName(ByVal vNewValue As String)
|
||||
If pItemName <> vNewValue Then pItemName = vNewValue: pIsDirty = True
|
||||
End Property
|
||||
|
||||
' ------------------------------------------------------------------------------
|
||||
' 属性: Quantity (数量)
|
||||
' ------------------------------------------------------------------------------
|
||||
Public Property Get Quantity() As Double: Quantity = pQuantity: End Property
|
||||
Public Property Let Quantity(ByVal vNewValue As Double)
|
||||
If pQuantity <> vNewValue Then pQuantity = vNewValue: pIsDirty = True
|
||||
End Property
|
||||
|
||||
' ------------------------------------------------------------------------------
|
||||
' 属性: Condition (选择条件) - 这是本工具最核心要修改的字段
|
||||
' ------------------------------------------------------------------------------
|
||||
Public Property Get Condition() As String: Condition = pCondition: End Property
|
||||
Public Property Let Condition(ByVal vNewValue As String)
|
||||
' 只有当新写入的值和原有的值不一样时,才判定为被修改,打上脏标记
|
||||
If pCondition <> vNewValue Then
|
||||
pCondition = vNewValue
|
||||
pIsDirty = True
|
||||
End If
|
||||
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 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 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 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 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 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
|
||||
|
||||
' ------------------------------------------------------------------------------
|
||||
' 状态追踪:只读的 IsDirty 和重置方法
|
||||
' ------------------------------------------------------------------------------
|
||||
Public Property Get IsDirty() As Boolean
|
||||
IsDirty = pIsDirty
|
||||
End Property
|
||||
|
||||
' 可以在写回 Excel 后,调用此方法将状态重置为干净
|
||||
Public Sub ResetDirtyFlag()
|
||||
pIsDirty = False
|
||||
End Sub
|
||||
123
VBA/ClassModules/cConditionEngine.cls
Normal file
123
VBA/ClassModules/cConditionEngine.cls
Normal file
@@ -0,0 +1,123 @@
|
||||
' ==============================================================================
|
||||
' 模块名称: cConditionEngine
|
||||
' 模块类别: 类模块 (Class Module)
|
||||
' 所属项目: BOMForge
|
||||
' 模块职责: 负责安全的BOM条件字符串手术,解析并注入新的条件分支
|
||||
' ==============================================================================
|
||||
Option Explicit
|
||||
|
||||
Private regEx As Object
|
||||
|
||||
Private Sub Class_Initialize()
|
||||
' 使用后期绑定创建正则表达式对象,无需手动在VBE中引用库,提高兼容性
|
||||
Set regEx = CreateObject("VBScript.RegExp")
|
||||
regEx.Global = True
|
||||
regEx.IgnoreCase = True
|
||||
End Sub
|
||||
|
||||
Private Sub Class_Terminate()
|
||||
' 释放对象内存
|
||||
Set regEx = Nothing
|
||||
End Sub
|
||||
|
||||
' ------------------------------------------------------------------------------
|
||||
' 函数名称: InjectOr
|
||||
' 函数功能: 将新参数作为 OR 条件安全地注入到现有的逻辑表达式中
|
||||
' 参数说明:
|
||||
' - expression: 原始的条件字符串,例如 "lcfw=M01 AND gclj!=M20"
|
||||
' - paramName: 要注入的参数名,例如 "lcfw"
|
||||
' - newValue: 要注入的新值,例如 "M19"
|
||||
' 返回值: 注入后的新字符串
|
||||
' ------------------------------------------------------------------------------
|
||||
Public Function InjectOr(ByVal expression As String, ByVal paramName As String, ByVal newValue As String) As String
|
||||
Dim targetCondition As String
|
||||
targetCondition = paramName & "=" & newValue
|
||||
|
||||
' [防御机制 1]:如果原表达式中已经存在我们要注入的完整条件,直接返回原字符串
|
||||
If InStr(1, expression, targetCondition, vbTextCompare) > 0 Then
|
||||
InjectOr = expression
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' [防御机制 2]:如果原表达式中根本不存在这个参数(如全是azxs),则忽略(业务上一般只在同类规格上追加)
|
||||
If InStr(1, expression, paramName & "=", vbTextCompare) = 0 And _
|
||||
InStr(1, expression, paramName & " =", vbTextCompare) = 0 Then
|
||||
InjectOr = expression
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' ==========================================================================
|
||||
' 场景 A:参数存在于括号内部
|
||||
' 示例:(lcfw=M12 OR lcfw=M13) AND gclj!=M20
|
||||
' 动作:找到括号,并在右括号前插入 " OR lcfw=M19"
|
||||
' ==========================================================================
|
||||
' 正则解释: 匹配左括号,中间不包含右括号,且包含目标参数=的片段,直到右括号
|
||||
regEx.Pattern = "\([^)]*\b" & paramName & "\b\s*=[^)]*\)"
|
||||
|
||||
If regEx.Test(expression) Then
|
||||
Dim matchBlocks As Object
|
||||
Dim matchBlock As Object
|
||||
Set matchBlocks = regEx.Execute(expression)
|
||||
|
||||
Dim resultExpr As String
|
||||
resultExpr = expression
|
||||
|
||||
' 遍历所有匹配的括号块并替换(万一存在多个括号里都有lcfw)
|
||||
For Each matchBlock In matchBlocks
|
||||
Dim oldBlockStr As String
|
||||
oldBlockStr = matchBlock.value
|
||||
|
||||
Dim newBlockStr As String
|
||||
' 剥离最后的右括号,加上我们要追加的条件,再把右括号补回去
|
||||
newBlockStr = Left(oldBlockStr, Len(oldBlockStr) - 1) & " OR " & targetCondition & ")"
|
||||
|
||||
' 在主字符串中执行替换
|
||||
resultExpr = Replace(resultExpr, oldBlockStr, newBlockStr)
|
||||
Next matchBlock
|
||||
|
||||
InjectOr = resultExpr
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' ==========================================================================
|
||||
' 场景 B:参数在括号外部,且表达式中存在 AND 逻辑
|
||||
' 示例:lcfw=M01 AND gclj!=M20
|
||||
' 动作:必须加括号包裹它,变成 (lcfw=M01 OR lcfw=M19) AND gclj!=M20
|
||||
' ==========================================================================
|
||||
If InStr(1, expression, "AND", vbTextCompare) > 0 Then
|
||||
' 正则解释:匹配单独的参数表达式,如 lcfw=M01 (允许等号两边有空格)
|
||||
regEx.Pattern = "\b" & paramName & "\s*=\s*[A-Za-z0-9_]+"
|
||||
|
||||
If regEx.Test(expression) Then
|
||||
Dim standaloneMatches As Object
|
||||
Dim sMatch As Object
|
||||
Set standaloneMatches = regEx.Execute(expression)
|
||||
|
||||
Dim resultStandalone As String
|
||||
resultStandalone = expression
|
||||
|
||||
For Each sMatch In standaloneMatches
|
||||
Dim oldStandaloneStr As String
|
||||
oldStandaloneStr = sMatch.value
|
||||
|
||||
Dim newStandaloneStr As String
|
||||
' 将原来独立的条件包裹进括号,并追加 OR 逻辑
|
||||
newStandaloneStr = "(" & oldStandaloneStr & " OR " & targetCondition & ")"
|
||||
|
||||
resultStandalone = Replace(resultStandalone, oldStandaloneStr, newStandaloneStr)
|
||||
Next sMatch
|
||||
|
||||
InjectOr = resultStandalone
|
||||
Exit Function
|
||||
End If
|
||||
End If
|
||||
|
||||
' ==========================================================================
|
||||
' 场景 C:没有任何括号,也没有 AND 逻辑,纯 OR 链
|
||||
' 示例:lcfw=M01 OR lcfw=M02 OR lcfw=M03 (如盘止钉)
|
||||
' 动作:直接在字符串最末尾追加即可
|
||||
' ==========================================================================
|
||||
expression = Trim(expression)
|
||||
InjectOr = expression & " OR " & targetCondition
|
||||
|
||||
End Function
|
||||
130
VBA/Modules/mTestEngine.bas
Normal file
130
VBA/Modules/mTestEngine.bas
Normal file
@@ -0,0 +1,130 @@
|
||||
' ==============================================================================
|
||||
' 模块名称: mTestEngine
|
||||
' 模块类别: 标准模块 (Standard Module)
|
||||
' 模块职责: 专门用于测试 cConditionEngine 类的逻辑准确性 (引入轻量级单元测试框架)
|
||||
' ==============================================================================
|
||||
Option Explicit
|
||||
|
||||
' 定义模块级变量,用于统计测试结果
|
||||
Private passCount As Integer
|
||||
Private failCount As Integer
|
||||
|
||||
Public Sub RunBOMForgeTests()
|
||||
' 初始化计数器
|
||||
passCount = 0
|
||||
failCount = 0
|
||||
|
||||
' 执行条件引擎测试
|
||||
Call Test_ConditionEngine
|
||||
|
||||
' 执行数据模型测试 (新增)
|
||||
Call Test_cBOMRow
|
||||
|
||||
' ---- 输出测试汇总 ----
|
||||
Debug.Print "-----------------------------------------------"
|
||||
Debug.Print "测试汇总: 共 " & (passCount + failCount) & " 个用例"
|
||||
Debug.Print "通过: " & passCount & " 失败: " & failCount
|
||||
If failCount = 0 Then
|
||||
Debug.Print ">>> 状态: 全部通过! (ALL PASS)"
|
||||
Else
|
||||
Debug.Print ">>> 状态: 存在失败用例,请检查逻辑!"
|
||||
End If
|
||||
Debug.Print "========== BOMForge 测试框架结束 =========="
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Test_ConditionEngine()
|
||||
Dim conditionEngine As cConditionEngine
|
||||
Set conditionEngine = New cConditionEngine
|
||||
|
||||
Dim originStr As String
|
||||
Dim expectedStr As String
|
||||
Dim paramName As String
|
||||
Dim newValue As String
|
||||
|
||||
paramName = "lcfw"
|
||||
newValue = "M19"
|
||||
|
||||
Debug.Print "========== 1. 开始测试: cConditionEngine =========="
|
||||
|
||||
' ---- 测试用例 1: 盘止钉 (纯 OR 链,无 AND,无括号) ----
|
||||
originStr = "lcfw=M01 OR lcfw=M02 OR lcfw=M30"
|
||||
expectedStr = "lcfw=M01 OR lcfw=M02 OR lcfw=M30 OR lcfw=M19"
|
||||
AssertEqual "场景1_盘止钉", expectedStr, conditionEngine.InjectOr(originStr, paramName, newValue)
|
||||
|
||||
' ---- 测试用例 2: 接头 (括号包裹的 OR 链,外面有 AND) ----
|
||||
originStr = "(azxs=A0 OR azxs=AT OR azxs=AH) AND gclj=Z14 AND (lcfw=M12 OR lcfw=M13 OR lcfw=M14 OR lcfw=M15 OR lcfw=M16)"
|
||||
expectedStr = "(azxs=A0 OR azxs=AT OR azxs=AH) AND gclj=Z14 AND (lcfw=M12 OR lcfw=M13 OR lcfw=M14 OR lcfw=M15 OR lcfw=M16 OR lcfw=M19)"
|
||||
AssertEqual "场景2_接头", expectedStr, conditionEngine.InjectOr(originStr, paramName, newValue)
|
||||
|
||||
' ---- 测试用例 3: 弹性元件 (孤立的参数,外面有 AND,需自动加括号) ----
|
||||
originStr = "lcfw=M01 AND gclj!=M20"
|
||||
expectedStr = "(lcfw=M01 OR lcfw=M19) AND gclj!=M20"
|
||||
AssertEqual "场景3_弹簧管", expectedStr, conditionEngine.InjectOr(originStr, paramName, newValue)
|
||||
|
||||
' ---- 测试用例 4: 封口片 (右侧紧跟 AND 的情况) ----
|
||||
originStr = "(lcfw=M12 OR lcfw=M13 OR lcfw=M14 OR lcfw=M15 OR lcfw=M16)AND gclj!=M20"
|
||||
expectedStr = "(lcfw=M12 OR lcfw=M13 OR lcfw=M14 OR lcfw=M15 OR lcfw=M16 OR lcfw=M19)AND gclj!=M20"
|
||||
AssertEqual "场景4_封口片", expectedStr, conditionEngine.InjectOr(originStr, paramName, newValue)
|
||||
|
||||
' ---- 测试用例 5: 防御性测试 (本身已经包含了目标条件,看是否会重复添加) ----
|
||||
originStr = "lcfw=M01 OR lcfw=M19"
|
||||
expectedStr = "lcfw=M01 OR lcfw=M19"
|
||||
AssertEqual "场景5_防重复", expectedStr, conditionEngine.InjectOr(originStr, paramName, newValue)
|
||||
|
||||
End Sub
|
||||
|
||||
' ==============================================================================
|
||||
' 新增:针对 cBOMRow 对象的单元测试
|
||||
' ==============================================================================
|
||||
Private Sub Test_cBOMRow()
|
||||
Debug.Print ""
|
||||
Debug.Print "========== 2. 开始测试: 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
|
||||
|
||||
' ==============================================================================
|
||||
' 内部辅助方法:断言测试结果
|
||||
' 将期望值与实际值进行比对,并输出标准化的日志信息
|
||||
' ==============================================================================
|
||||
Private Sub AssertEqual(testName As String, expected As String, actual As String)
|
||||
If expected = actual Then
|
||||
Debug.Print "[PASS] " & testName
|
||||
passCount = passCount + 1
|
||||
Else
|
||||
Debug.Print "[FAIL] " & testName
|
||||
Debug.Print " 期望结果: " & expected
|
||||
Debug.Print " 实际结果: " & actual
|
||||
failCount = failCount + 1
|
||||
End If
|
||||
End Sub
|
||||
Reference in New Issue
Block a user