' ============================================================================== ' 模块: M05_PreProcessor ' 职责: 预处理条件表达式,用于"接头"类别的值映射和去重 ' ============================================================================== Option Explicit ' 模块级变量 Private g_LcfwMapping As Object ' Scripting.Dictionary - lcfw映射表 Private g_AzxsMapping As Object ' Scripting.Dictionary - azxs映射表 Private g_Logger As clsErrorLogger Private g_IsInitialized As Boolean ' ------------------------------------------------------------------------------ ' 初始化预处理器 ' ------------------------------------------------------------------------------ Public Sub InitPreProcessor(logger As clsErrorLogger, wsMapping As Worksheet) Set g_Logger = logger Set g_LcfwMapping = CreateObject("Scripting.Dictionary") Set g_AzxsMapping = CreateObject("Scripting.Dictionary") ' 从[对照表]加载映射 Call LoadLcfwMapping(wsMapping) Call LoadAzxsMapping(wsMapping) g_IsInitialized = True End Sub ' ------------------------------------------------------------------------------ ' 检查是否已初始化 ' ------------------------------------------------------------------------------ Public Function IsInitialized() As Boolean IsInitialized = g_IsInitialized End Function ' ------------------------------------------------------------------------------ ' 主入口:预处理条件表达式 ' ------------------------------------------------------------------------------ Public Function PreprocessCondition( _ ByVal strCondition As String, _ ByVal strCategory As String, _ ByVal rowIdx As Long _ ) As String ' 仅对"接头"类别进行预处理 If strCategory <> "接头" Then PreprocessCondition = strCondition Exit Function End If If Not g_IsInitialized Then PreprocessCondition = strCondition Exit Function End If PreprocessCondition = ApplyPreprocessing(strCondition, rowIdx) End Function ' ------------------------------------------------------------------------------ ' 加载lcfw映射(从A列:B列,列1:2) ' ------------------------------------------------------------------------------ Private Sub LoadLcfwMapping(wsMapping As Worksheet) Dim lastRow As Long lastRow = wsMapping.Cells(wsMapping.Rows.count, 1).End(xlUp).Row Dim i As Long Dim key As String, val As String ' 从第3行开始读取 For i = 3 To lastRow key = Trim(CStr(wsMapping.Cells(i, 1).Value)) val = Trim(CStr(wsMapping.Cells(i, 2).Value)) If Len(key) > 0 And Len(val) > 0 Then If Not g_LcfwMapping.Exists(key) Then g_LcfwMapping.Add key, val End If End If Next i End Sub ' ------------------------------------------------------------------------------ ' 加载azxs映射(从D列:E列,列4:5) ' ------------------------------------------------------------------------------ Private Sub LoadAzxsMapping(wsMapping As Worksheet) Dim lastRow As Long lastRow = wsMapping.Cells(wsMapping.Rows.count, 4).End(xlUp).Row Dim i As Long Dim key As String, val As String ' 从第3行开始读取 For i = 3 To lastRow key = Trim(CStr(wsMapping.Cells(i, 4).Value)) val = Trim(CStr(wsMapping.Cells(i, 5).Value)) If Len(key) > 0 And Len(val) > 0 Then If Not g_AzxsMapping.Exists(key) Then g_AzxsMapping.Add key, val End If End If Next i End Sub ' ------------------------------------------------------------------------------ ' 应用预处理:值替换和OR去重(递归处理嵌套表达式) ' ------------------------------------------------------------------------------ Private Function ApplyPreprocessing( _ ByVal strCondition As String, _ ByVal rowIdx As Long _ ) As String ' 首先递归处理括号内的表达式并简化 strCondition = ProcessAndSimplifyNested(strCondition, rowIdx) ' 然后按顶层OR分割 Dim orSegments As Collection Set orSegments = SplitTopLevel(strCondition, " OR ") If orSegments.count = 1 Then ' 没有顶层OR,直接处理AND分段 ApplyPreprocessing = ProcessAndSegment(CStr(orSegments(1)), rowIdx) Exit Function End If ' 处理每个OR分段 Dim processedSegments As Collection Set processedSegments = New Collection Dim segment As Variant For Each segment In orSegments Dim processedSegment As String processedSegment = ProcessAndSegment(CStr(segment), rowIdx) processedSegments.Add processedSegment Next segment ' 合并去重后的OR条件 ApplyPreprocessing = MergeDuplicateORs(processedSegments) End Function ' ------------------------------------------------------------------------------ ' 递归处理并简化嵌套表达式 ' ------------------------------------------------------------------------------ Private Function ProcessAndSimplifyNested( _ ByVal strCondition As String, _ ByVal rowIdx As Long _ ) As String Dim result As String result = "" Dim i As Long Dim bracketLevel As Long bracketLevel = 0 Dim inBracket As Boolean inBracket = False Dim bracketContent As String bracketContent = "" For i = 1 To Len(strCondition) Dim char As String char = Mid(strCondition, i, 1) If char = "(" Then bracketLevel = bracketLevel + 1 If bracketLevel = 1 Then inBracket = True bracketContent = "" Else bracketContent = bracketContent & char End If ElseIf char = ")" Then If bracketLevel = 1 Then ' 递归处理括号内的内容 Dim processedContent As String processedContent = ProcessAndSimplifyNested(bracketContent, rowIdx) ' 简化处理后的内容(应用值替换和OR合并) processedContent = ApplyPreprocessing(processedContent, rowIdx) ' 检查所有OR分段是否相同,如果是则去重 processedContent = SimplifyIfAllSame(processedContent) ' 重新组装:决定是否需要保留括号 ' 如果处理后的内容包含顶层 OR 或 AND,需要加括号以保持正确的逻辑结构 Dim needsParens As Boolean needsParens = HasTopLevelOperator(processedContent, " OR ") Or _ HasTopLevelOperator(processedContent, " AND ") If needsParens Then result = result & "(" & processedContent & ")" Else result = result & processedContent End If inBracket = False Else bracketContent = bracketContent & char End If bracketLevel = bracketLevel - 1 ElseIf inBracket Then bracketContent = bracketContent & char Else result = result & char End If Next i ProcessAndSimplifyNested = result End Function ' ------------------------------------------------------------------------------ ' 如果所有OR分段都相同,则简化为单个分段 ' ------------------------------------------------------------------------------ Private Function SimplifyIfAllSame( _ ByVal strExpr As String _ ) As String ' 检查是否包含OR If Not HasTopLevelOperator(strExpr, " OR ") Then SimplifyIfAllSame = strExpr Exit Function End If ' 分割OR分段 Dim segments As Collection Set segments = SplitTopLevel(strExpr, " OR ") If segments.count <= 1 Then SimplifyIfAllSame = strExpr Exit Function End If ' 检查所有分段是否相同 Dim allSame As Boolean allSame = True Dim firstSegment As String firstSegment = NormalizeWhitespace(CStr(segments(1))) Dim i As Long For i = 2 To segments.count Dim segment As String segment = NormalizeWhitespace(CStr(segments(i))) If segment <> firstSegment Then allSame = False Exit For End If Next i ' 如果所有分段都相同,返回第一个分段 If allSame Then SimplifyIfAllSame = segments(1) Else SimplifyIfAllSame = strExpr End If End Function ' ------------------------------------------------------------------------------ ' 尝试去除外层括号(如果可能) ' ------------------------------------------------------------------------------ Private Function MaybeRemoveOuterParentheses( _ ByVal strExpr As String _ ) As String strExpr = Trim(strExpr) ' 如果没有外层括号,直接返回 If Left(strExpr, 1) <> "(" Or Right(strExpr, 1) <> ")" Then MaybeRemoveOuterParentheses = strExpr Exit Function End If ' 去掉外层括号,检查内容 Dim innerContent As String innerContent = Mid(strExpr, 2, Len(strExpr) - 2) innerContent = Trim(innerContent) ' 检查内容是否包含顶层OR或AND Dim hasTopLevelOR As Boolean Dim hasTopLevelAND As Boolean hasTopLevelOR = HasTopLevelOperator(innerContent, " OR ") hasTopLevelAND = HasTopLevelOperator(innerContent, " AND ") ' 如果没有顶层操作符,可以去掉括号 If Not hasTopLevelOR And Not hasTopLevelAND Then MaybeRemoveOuterParentheses = innerContent Exit Function End If ' 如果仍有顶层操作符,需要保留括号以保持正确的逻辑结构 MaybeRemoveOuterParentheses = strExpr End Function ' ------------------------------------------------------------------------------ ' 检查字符串是否包含顶层操作符 ' ------------------------------------------------------------------------------ Private Function HasTopLevelOperator( _ ByVal strExpr As String, _ ByVal operator As String _ ) As Boolean Dim bracketLevel As Long bracketLevel = 0 Dim i As Long Dim lenOp As Long lenOp = Len(operator) For i = 1 To Len(strExpr) - lenOp + 1 Dim char As String char = Mid(strExpr, i, 1) If char = "(" Then bracketLevel = bracketLevel + 1 ElseIf char = ")" Then bracketLevel = bracketLevel - 1 ElseIf bracketLevel = 0 Then If Mid(strExpr, i, lenOp) = operator Then HasTopLevelOperator = True Exit Function End If End If Next i HasTopLevelOperator = False End Function ' ------------------------------------------------------------------------------ ' 处理AND分段:进行值替换并合并重复原子 ' ------------------------------------------------------------------------------ Private Function ProcessAndSegment( _ ByVal strSegment As String, _ ByVal rowIdx As Long _ ) As String Dim andAtoms As Collection Set andAtoms = SplitTopLevel(strSegment, " AND ") Dim processedAtoms As Collection Set processedAtoms = New Collection Dim atom As Variant For Each atom In andAtoms Dim processedAtom As String processedAtom = ProcessAtom(CStr(atom), rowIdx) processedAtoms.Add processedAtom Next atom ' 合并重复的原子 Dim mergedAtoms As Collection Set mergedAtoms = MergeDuplicateAtoms(processedAtoms) ' 重新组合AND分段 ProcessAndSegment = JoinCollection(mergedAtoms, " AND ") End Function ' ------------------------------------------------------------------------------ ' 处理单个原子:应用值映射 ' ------------------------------------------------------------------------------ Private Function ProcessAtom( _ ByVal strAtom As String, _ ByVal rowIdx As Long _ ) As String Dim atomDict As Object Set atomDict = ParseAtom(strAtom) If atomDict Is Nothing Then ProcessAtom = strAtom Exit Function End If Dim key As String Dim value As String Dim operator As String key = atomDict("key") value = atomDict("value") operator = atomDict("operator") ' 应用映射 Dim mappedValue As String mappedValue = "" If key = "lcfw" Then If g_LcfwMapping.Exists(value) Then mappedValue = g_LcfwMapping(value) End If ElseIf key = "azxs" Then If g_AzxsMapping.Exists(value) Then mappedValue = g_AzxsMapping(value) End If End If ' 如果找到了映射值,使用它;否则保持原值 If Len(mappedValue) > 0 Then value = mappedValue Else ' 记录警告(仅针对lcfw和azxs) If (key = "lcfw" Or key = "azxs") And Len(value) > 0 Then g_Logger.Record rowIdx, "M05.PreProcessor", "Mapping Warning", _ "Value not found in mapping table: " & key & "=" & value, strAtom End If End If ' 重建原子字符串 ProcessAtom = key & operator & value End Function ' ------------------------------------------------------------------------------ ' 解析原子字符串为Dictionary ' ------------------------------------------------------------------------------ Private Function ParseAtom(ByVal strAtom As String) As Object Set ParseAtom = Nothing strAtom = Trim(strAtom) If Len(strAtom) = 0 Then Exit Function Dim dict As Object Set dict = CreateObject("Scripting.Dictionary") Dim p As Long Dim key As String, value As String, op As String If InStr(strAtom, "!=") > 0 Then p = InStr(strAtom, "!=") key = Trim(Left(strAtom, p - 1)) value = Trim(Mid(strAtom, p + 2)) op = "!=" ElseIf InStr(strAtom, "=") > 0 Then p = InStr(strAtom, "=") key = Trim(Left(strAtom, p - 1)) value = Trim(Mid(strAtom, p + 1)) op = "=" Else Exit Function End If dict.Add "key", key dict.Add "value", value dict.Add "operator", op Set ParseAtom = dict End Function ' ------------------------------------------------------------------------------ ' 顶层分割(尊重括号嵌套) ' ------------------------------------------------------------------------------ Private Function SplitTopLevel( _ ByVal strExpr As String, _ ByVal delimiter As String _ ) As Collection Dim result As New Collection Dim currentSegment As String currentSegment = "" Dim i As Long Dim bracketLevel As Long bracketLevel = 0 Dim lenDelim As Long lenDelim = Len(delimiter) i = 1 Do While i <= Len(strExpr) Dim char As String char = Mid(strExpr, i, 1) If char = "(" Then bracketLevel = bracketLevel + 1 currentSegment = currentSegment & char ElseIf char = ")" Then bracketLevel = bracketLevel - 1 currentSegment = currentSegment & char ElseIf bracketLevel = 0 Then ' 检查是否匹配分隔符 If i + lenDelim - 1 <= Len(strExpr) Then Dim checkStr As String checkStr = Mid(strExpr, i, lenDelim) If UCase(checkStr) = delimiter Then ' 找到分隔符,保存当前分段 result.Add Trim(currentSegment) currentSegment = "" i = i + lenDelim - 1 ' 跳过分隔符 Else currentSegment = currentSegment & char End If Else currentSegment = currentSegment & char End If Else currentSegment = currentSegment & char End If i = i + 1 Loop ' 添加最后一个分段 If Len(Trim(currentSegment)) > 0 Then result.Add Trim(currentSegment) End If Set SplitTopLevel = result End Function ' ------------------------------------------------------------------------------ ' 合并重复的OR条件 ' ------------------------------------------------------------------------------ Private Function MergeDuplicateORs(ByVal segments As Collection) As String If segments.count = 0 Then MergeDuplicateORs = "" Exit Function End If If segments.count = 1 Then MergeDuplicateORs = segments(1) Exit Function End If ' 使用Dictionary去重 Dim uniqueSegments As Object Set uniqueSegments = CreateObject("Scripting.Dictionary") Dim segment As Variant For Each segment In segments Dim segStr As String segStr = CStr(segment) ' 标准化字符串用于比较(去除多余空格) Dim normalized As String normalized = NormalizeWhitespace(segStr) If Not uniqueSegments.Exists(normalized) Then uniqueSegments.Add normalized, segStr End If Next segment ' 重新组合 Dim result As String result = "" Dim key As Variant Dim isFirst As Boolean isFirst = True For Each key In uniqueSegments.keys If isFirst Then result = uniqueSegments(key) isFirst = False Else result = result & " OR " & uniqueSegments(key) End If Next key MergeDuplicateORs = result End Function ' ------------------------------------------------------------------------------ ' 标准化空白字符 ' ------------------------------------------------------------------------------ Private Function NormalizeWhitespace(ByVal str As String) As String ' 去除多余空格 Dim result As String result = Trim(str) ' 将连续多个空格替换为单个空格 Do While InStr(result, " ") > 0 result = Replace(result, " ", " ") Loop ' 标准化 " AND " 和 " OR " result = Replace(result, " AND ", " AND ") result = Replace(result, " OR ", " OR ") NormalizeWhitespace = result End Function ' ------------------------------------------------------------------------------ ' 连接集合为字符串 ' ------------------------------------------------------------------------------ Private Function JoinCollection( _ ByVal col As Collection, _ ByVal delimiter As String _ ) As String Dim result As String result = "" Dim item As Variant Dim isFirst As Boolean isFirst = True For Each item In col If isFirst Then result = CStr(item) isFirst = False Else result = result & delimiter & CStr(item) End If Next item JoinCollection = result End Function ' ------------------------------------------------------------------------------ ' 合并重复的原子(在AND分段中) ' ------------------------------------------------------------------------------ Private Function MergeDuplicateAtoms( _ ByVal atoms As Collection _ ) As Collection Dim result As New Collection Dim uniqueAtoms As Object Set uniqueAtoms = CreateObject("Scripting.Dictionary") Dim atom As Variant For Each atom In atoms Dim atomStr As String atomStr = Trim(CStr(atom)) ' 标准化用于比较 Dim normalized As String normalized = NormalizeWhitespace(atomStr) If Not uniqueAtoms.Exists(normalized) Then uniqueAtoms.Add normalized, atomStr End If Next atom ' 返回去重后的原子 Dim key As Variant For Each key In uniqueAtoms.keys result.Add uniqueAtoms(key) Next key Set MergeDuplicateAtoms = result End Function ' ------------------------------------------------------------------------------ ' 测试辅助函数:获取lcfw映射值 ' ------------------------------------------------------------------------------ Public Function GetLcfwMappedValue(key As String) As String If g_LcfwMapping.Exists(key) Then GetLcfwMappedValue = g_LcfwMapping(key) Else GetLcfwMappedValue = "" End If End Function ' ------------------------------------------------------------------------------ ' 测试辅助函数:获取azxs映射值 ' ------------------------------------------------------------------------------ Public Function GetAzxsMappedValue(key As String) As String If g_AzxsMapping.Exists(key) Then GetAzxsMappedValue = g_AzxsMapping(key) Else GetAzxsMappedValue = "" End If End Function