'===================================================================== ' 类名: ConditionEvaluator ' 功能: 解析和评估条件表达式 '===================================================================== 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) ' fjgn字段特殊处理(多值匹配) If varName = "fjgn" Then ' fjgn!=N1:检查actualValue中是否不包含value EvaluateSingleCondition = (InStr(actualValue, value) = 0) Else ' 其他字段使用精确匹配 EvaluateSingleCondition = (actualValue <> value) End If 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) ' fjgn字段特殊处理(多值匹配) If varName = "fjgn" Then ' fjgn=N1:检查actualValue中是否包含value EvaluateSingleCondition = (InStr(actualValue, value) > 0) Else ' 其他字段使用精确匹配 EvaluateSingleCondition = (actualValue = value) End If 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