feat: add core VBA source code modules
Add VBA directory with essential project code including: - ClassModules: BomExtractor, BomItem, ConditionEvaluator, ProductModelParser - Modules: MainModule, TestModule - Forms and DocumentModules - vba_metadata.json for module metadata Co-Authored-By: Claude Sonnet 4.5 <noreply@anthropic.com>
This commit is contained in:
Misaka
210
VBA/ClassModules/ConditionEvaluator.cls
Normal file
210
VBA/ClassModules/ConditionEvaluator.cls
Normal file
@@ -0,0 +1,210 @@
|
||||
'=====================================================================
|
||||
' 类名: ConditionEvaluator
|
||||
' 功能: 解析和评估条件表达式
|
||||
' 作者: Auto-generated
|
||||
' 日期: 2025-01-29
|
||||
'=====================================================================
|
||||
|
||||
Option Explicit
|
||||
|
||||
'=====================================================================
|
||||
' 方法: Evaluate
|
||||
' 功能: 评估条件表达式
|
||||
' 参数: expression - 条件表达式字符串
|
||||
' productConditions - 产品条件字典(Dictionary对象)
|
||||
' 返回: Boolean - True表示条件满足,False表示不满足
|
||||
' 说明: 支持AND、OR、!=运算符和括号嵌套
|
||||
' 特殊规则:如果表达式中要求!=某值,而产品条件中不存在该变量,视为满足条件
|
||||
'=====================================================================
|
||||
Public Function Evaluate(expression As String, productConditions As Object) As Boolean
|
||||
On Error GoTo ErrorHandler
|
||||
|
||||
' 空条件视为满足
|
||||
If Trim(expression) = "" Then
|
||||
Evaluate = True
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' 递归解析表达式
|
||||
Evaluate = EvaluateExpression(Trim(expression), productConditions)
|
||||
Exit Function
|
||||
|
||||
ErrorHandler:
|
||||
' 解析错误时返回False
|
||||
Evaluate = False
|
||||
End Function
|
||||
|
||||
'=====================================================================
|
||||
' 方法: EvaluateExpression
|
||||
' 功能: 递归评估表达式
|
||||
' 参数: expr - 表达式
|
||||
' conditions - 条件字典
|
||||
' 返回: Boolean
|
||||
'=====================================================================
|
||||
Private Function EvaluateExpression(expr As String, Conditions As Object) As Boolean
|
||||
expr = Trim(expr)
|
||||
|
||||
' 处理最外层括号
|
||||
If Left(expr, 1) = "(" And Right(expr, 1) = ")" Then
|
||||
If IsMatchedParentheses(expr) Then
|
||||
expr = Mid(expr, 2, Len(expr) - 2)
|
||||
expr = Trim(expr)
|
||||
End If
|
||||
End If
|
||||
|
||||
' 处理OR运算符(优先级最低)
|
||||
Dim orResult As Variant
|
||||
orResult = SplitByOperator(expr, " OR ", Conditions)
|
||||
If Not IsEmpty(orResult) Then
|
||||
EvaluateExpression = orResult
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' 处理AND运算符
|
||||
Dim andResult As Variant
|
||||
andResult = SplitByOperator(expr, " AND ", Conditions)
|
||||
If Not IsEmpty(andResult) Then
|
||||
EvaluateExpression = andResult
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
' 处理单个条件
|
||||
EvaluateExpression = EvaluateSingleCondition(expr, Conditions)
|
||||
End Function
|
||||
|
||||
'=====================================================================
|
||||
' 方法: SplitByOperator
|
||||
' 功能: 按指定运算符分割并评估表达式
|
||||
' 参数: expr - 表达式
|
||||
' operator - 运算符(" OR " 或 " AND ")
|
||||
' conditions - 条件字典
|
||||
' 返回: Variant - 评估结果或Empty
|
||||
'=====================================================================
|
||||
Private Function SplitByOperator(expr As String, operator As String, Conditions As Object) As Variant
|
||||
Dim pos As Long
|
||||
Dim leftPart As String
|
||||
Dim rightPart As String
|
||||
Dim depth As Long
|
||||
Dim i As Long
|
||||
Dim char As String
|
||||
|
||||
' 寻找不在括号内的运算符
|
||||
depth = 0
|
||||
For i = 1 To Len(expr) - Len(operator) + 1
|
||||
char = Mid(expr, i, 1)
|
||||
|
||||
If char = "(" Then
|
||||
depth = depth + 1
|
||||
ElseIf char = ")" Then
|
||||
depth = depth - 1
|
||||
ElseIf depth = 0 Then
|
||||
' 检查是否匹配运算符
|
||||
If Mid(expr, i, Len(operator)) = operator Then
|
||||
leftPart = Trim(Left(expr, i - 1))
|
||||
rightPart = Trim(Mid(expr, i + Len(operator)))
|
||||
|
||||
' 根据运算符类型评估
|
||||
If operator = " OR " Then
|
||||
SplitByOperator = EvaluateExpression(leftPart, Conditions) Or _
|
||||
EvaluateExpression(rightPart, Conditions)
|
||||
ElseIf operator = " AND " Then
|
||||
SplitByOperator = EvaluateExpression(leftPart, Conditions) And _
|
||||
EvaluateExpression(rightPart, Conditions)
|
||||
End If
|
||||
Exit Function
|
||||
End If
|
||||
End If
|
||||
Next i
|
||||
|
||||
' 未找到运算符
|
||||
SplitByOperator = Empty
|
||||
End Function
|
||||
|
||||
'=====================================================================
|
||||
' 方法: EvaluateSingleCondition
|
||||
' 功能: 评估单个条件(如 azxs=A0 或 azxs!=AH)
|
||||
' 参数: condition - 单个条件字符串
|
||||
' conditions - 条件字典
|
||||
' 返回: Boolean
|
||||
'=====================================================================
|
||||
Private Function EvaluateSingleCondition(condition As String, Conditions As Object) As Boolean
|
||||
Dim varName As String
|
||||
Dim operator As String
|
||||
Dim value As String
|
||||
Dim actualValue As String
|
||||
|
||||
condition = Trim(condition)
|
||||
|
||||
' 检查!=运算符
|
||||
If InStr(condition, "!=") > 0 Then
|
||||
Dim parts() As String
|
||||
parts = Split(condition, "!=")
|
||||
If UBound(parts) >= 1 Then
|
||||
varName = Trim(parts(0))
|
||||
value = Trim(parts(1))
|
||||
|
||||
' 特殊规则:如果产品条件中不存在该变量,视为满足!=条件
|
||||
If Not Conditions.Exists(varName) Then
|
||||
EvaluateSingleCondition = True
|
||||
Else
|
||||
actualValue = Conditions(varName)
|
||||
EvaluateSingleCondition = (actualValue <> value)
|
||||
End If
|
||||
Exit Function
|
||||
End If
|
||||
End If
|
||||
|
||||
' 检查=运算符
|
||||
If InStr(condition, "=") > 0 Then
|
||||
Dim eqParts() As String
|
||||
eqParts = Split(condition, "=")
|
||||
If UBound(eqParts) >= 1 Then
|
||||
varName = Trim(eqParts(0))
|
||||
value = Trim(eqParts(1))
|
||||
|
||||
If Not Conditions.Exists(varName) Then
|
||||
EvaluateSingleCondition = False
|
||||
Else
|
||||
actualValue = Conditions(varName)
|
||||
EvaluateSingleCondition = (actualValue = value)
|
||||
End If
|
||||
Exit Function
|
||||
End If
|
||||
End If
|
||||
|
||||
' 无法解析的条件返回False
|
||||
EvaluateSingleCondition = False
|
||||
End Function
|
||||
|
||||
'=====================================================================
|
||||
' 方法: IsMatchedParentheses
|
||||
' 功能: 检查字符串最外层括号是否匹配
|
||||
' 参数: str - 字符串
|
||||
' 返回: Boolean
|
||||
'=====================================================================
|
||||
Private Function IsMatchedParentheses(str As String) As Boolean
|
||||
If Left(str, 1) <> "(" Or Right(str, 1) <> ")" Then
|
||||
IsMatchedParentheses = False
|
||||
Exit Function
|
||||
End If
|
||||
|
||||
Dim depth As Long
|
||||
Dim i As Long
|
||||
|
||||
depth = 0
|
||||
For i = 1 To Len(str)
|
||||
If Mid(str, i, 1) = "(" Then
|
||||
depth = depth + 1
|
||||
ElseIf Mid(str, i, 1) = ")" Then
|
||||
depth = depth - 1
|
||||
End If
|
||||
|
||||
' 如果在中间某处深度归零,说明最外层括号不匹配
|
||||
If depth = 0 And i < Len(str) Then
|
||||
IsMatchedParentheses = False
|
||||
Exit Function
|
||||
End If
|
||||
Next i
|
||||
|
||||
IsMatchedParentheses = (depth = 0)
|
||||
End Function
|
||||
Reference in New Issue
Block a user