' ======================================== ' 类模块: clsConditionMatcher ' 用途: 解析物料的选择条件表达式,并判断是否匹配 ' 支持: AND, OR, NOT(!=), 括号优先级 ' ======================================== Option Explicit ' ======================================== ' IsMatch 方法 ' 功能: 判断条件表达式是否匹配 ' 参数: ' conditionExpr - 条件表达式字符串 ' conditions - Dictionary对象,包含变量名->值的映射 ' 返回: Boolean - 是否匹配 ' 示例: ' IsMatch("lcfw=M16 AND gclj=M20", conditions) -> True/False ' ======================================== Public Function IsMatch(conditionExpr As String, conditions As Object) As Boolean On Error GoTo ErrorHandler ' 空条件表示无条件,始终匹配 If Trim(conditionExpr) = "" Then IsMatch = True Exit Function End If ' 解析并计算表达式 IsMatch = EvaluateExpression(Trim(conditionExpr), conditions) Exit Function ErrorHandler: ' 出错时返回False(保守处理) Debug.Print "条件匹配出错: " & conditionExpr & " - " & Err.description IsMatch = False End Function ' ======================================== ' EvaluateExpression 方法 (私有) ' 功能: 递归计算逻辑表达式 ' 优先级: 括号 > NOT(!=) > AND > OR ' ======================================== Private Function EvaluateExpression(expr As String, conditions As Object) As Boolean expr = Trim(expr) ' 处理括号 (最高优先级) If InStr(expr, "(") > 0 Then EvaluateExpression = EvaluateWithParentheses(expr, conditions) Exit Function End If ' 处理 OR (最低优先级) If InStr(expr, " OR ") > 0 Then EvaluateExpression = EvaluateOR(expr, conditions) Exit Function End If ' 处理 AND (中等优先级) If InStr(expr, " AND ") > 0 Then EvaluateExpression = EvaluateAND(expr, conditions) Exit Function End If ' 处理单个条件 (最高优先级) EvaluateExpression = EvaluateSimpleCondition(expr, conditions) End Function ' ======================================== ' EvaluateWithParentheses 方法 (私有) ' 功能: 处理包含括号的表达式 ' 策略: 找到最内层括号,递归计算,然后替换为结果 ' ======================================== Private Function EvaluateWithParentheses(expr As String, conditions As Object) As Boolean Dim pos As Long, level As Long, startPos As Long Dim i As Long Dim innerExpr As String Dim innerResult As Boolean Dim newExpr As String ' 查找最内层的括号对 startPos = 0 level = 0 For i = 1 To Len(expr) If Mid(expr, i, 1) = "(" Then If level = 0 Then startPos = i level = level + 1 ElseIf Mid(expr, i, 1) = ")" Then level = level - 1 If level = 0 And startPos > 0 Then ' 找到一对括号 innerExpr = Mid(expr, startPos + 1, i - startPos - 1) innerResult = EvaluateExpression(innerExpr, conditions) ' 替换括号部分为结果 newExpr = Left(expr, startPos - 1) & _ IIf(innerResult, "TRUE", "FALSE") & _ Mid(expr, i + 1) ' 递归处理剩余部分 EvaluateWithParentheses = EvaluateExpression(newExpr, conditions) Exit Function End If End If Next i ' 如果没有找到有效括号,直接计算 EvaluateWithParentheses = EvaluateExpression(expr, conditions) End Function ' ======================================== ' EvaluateOR 方法 (私有) ' 功能: 处理 OR 逻辑运算 ' 规则: 任一为真则为真 ' ======================================== Private Function EvaluateOR(expr As String, conditions As Object) As Boolean Dim parts() As String Dim part As Variant ' 按 OR 分割 parts = Split(expr, " OR ") ' 任一部分为真则返回真 For Each part In parts If EvaluateExpression(Trim(CStr(part)), conditions) Then EvaluateOR = True Exit Function End If Next part EvaluateOR = False End Function ' ======================================== ' EvaluateAND 方法 (私有) ' 功能: 处理 AND 逻辑运算 ' 规则: 全部为真才为真 ' ======================================== Private Function EvaluateAND(expr As String, conditions As Object) As Boolean Dim parts() As String Dim part As Variant ' 按 AND 分割 parts = Split(expr, " AND ") ' 全部部分为真才返回真 For Each part In parts If Not EvaluateExpression(Trim(CStr(part)), conditions) Then EvaluateAND = False Exit Function End If Next part EvaluateAND = True End Function ' ======================================== ' EvaluateSimpleCondition 方法 (私有) ' 功能: 计算单个条件表达式 ' 支持: = (等于), != (不等于) ' 格式: varName=value 或 varName!=value ' ======================================== Private Function EvaluateSimpleCondition(cond As String, conditions As Object) As Boolean cond = Trim(cond) ' 处理特殊值 TRUE/FALSE (括号计算的结果) If UCase(cond) = "TRUE" Then EvaluateSimpleCondition = True Exit Function ElseIf UCase(cond) = "FALSE" Then EvaluateSimpleCondition = False Exit Function End If Dim varName As String Dim expectedValue As String Dim actualValue As String Dim isNotEqual As Boolean ' 判断是 != 还是 = If InStr(cond, "!=") > 0 Then isNotEqual = True Dim parts1() As String parts1 = Split(cond, "!=") If UBound(parts1) < 1 Then EvaluateSimpleCondition = False Exit Function End If varName = Trim(parts1(0)) expectedValue = Trim(parts1(1)) ElseIf InStr(cond, "=") > 0 Then isNotEqual = False Dim parts2() As String parts2 = Split(cond, "=") If UBound(parts2) < 1 Then EvaluateSimpleCondition = False Exit Function End If varName = Trim(parts2(0)) expectedValue = Trim(parts2(1)) Else ' 无效的条件格式 EvaluateSimpleCondition = False Exit Function End If ' 获取实际值 If conditions.Exists(varName) Then actualValue = Trim(CStr(conditions(varName))) Else actualValue = "" End If ' 比较值 (不区分大小写) Dim isEqual As Boolean isEqual = (UCase(actualValue) = UCase(expectedValue)) ' 返回结果 If isNotEqual Then EvaluateSimpleCondition = Not isEqual Else EvaluateSimpleCondition = isEqual End If End Function ' ======================================== ' TestExpression 方法 ' 功能: 测试表达式是否有效 (用于调试) ' 参数: expr - 表达式字符串 ' 返回: String - "有效" 或 错误信息 ' ======================================== Public Function TestExpression(expr As String) As String On Error GoTo ErrorHandler ' 创建测试条件 Dim testConditions As Object Set testConditions = CreateObject("Scripting.Dictionary") testConditions("gclj") = "M20" testConditions("jycz") = "3" testConditions("lcfw") = "M16" ' 尝试计算 Dim result As Boolean result = IsMatch(expr, testConditions) TestExpression = "有效 (结果: " & IIf(result, "True", "False") & ")" Exit Function ErrorHandler: TestExpression = "无效: " & Err.description End Function