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:
Misaka_Company
2026-03-19 12:28:29 +08:00
parent 5c4f148c2a
commit f344cbe206
3 changed files with 374 additions and 0 deletions

View 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

View 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