Files
AutoBOM/VBA/Modules/M05_PreProcessor.bas
Misaka_Company ec579b30b2
All checks were successful
NTFY Notification / notify (push) Successful in 13s
feat: add azxs preprocessing support for component category
Extend M05_PreProcessor to support category-specific preprocessing:
- "接头" category: Full preprocessing (azxs + lcfw mapping, OR merging, parentheses simplification)
- "部件" category: Partial preprocessing (azxs mapping only, OR merging, parentheses simplification)
- Other categories: No preprocessing

Add new function ApplyPreprocessingWithoutLcfw() to handle component category preprocessing.

Add unit tests (PP_09 through PP_12) to verify:
- azxs mapping for component category
- lcfw conditions remain unchanged for component category
- OR condition merging and parentheses simplification

Update CLAUDE.md documentation with category-specific preprocessing table.

Co-Authored-By: Claude Sonnet 4.5 <noreply@anthropic.com>
2026-02-11 09:49:38 +08:00

633 lines
21 KiB
QBasic
Raw Blame History

This file contains ambiguous Unicode characters
This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
' ==============================================================================
' 模块: M05_PreProcessor
' 职责: 预处理条件表达式,支持不同类别的差异化处理
' - "接头"类别: 完整预处理azxs映射 + lcfw映射 + OR合并 + 括号简化)
' - "部件"类别: 部分预处理azxs映射 + OR合并 + 括号简化不处理lcfw
' - 其他类别: 不进行预处理
' 使用正则表达式实现高效的值映射和OR条件合并
' ==============================================================================
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
' ------------------------------------------------------------------------------
' 主入口:预处理条件表达式
' 支持的类别:
' - "接头": 完整预处理azxs映射 + lcfw映射 + OR合并 + 括号简化)
' - "部件": 部分预处理azxs映射 + OR合并 + 括号简化不处理lcfw
' - 其他: 不进行预处理
' ------------------------------------------------------------------------------
Public Function PreprocessCondition( _
ByVal strCondition As String, _
ByVal strCategory As String, _
ByVal rowIdx As Long _
) As String
If Not g_IsInitialized Then
PreprocessCondition = strCondition
Exit Function
End If
' 根据类别选择处理策略
If strCategory = "接头" Then
' 完整预处理azxs + lcfw + OR合并 + 括号简化
PreprocessCondition = ApplyPreprocessing(strCondition, rowIdx)
ElseIf strCategory = "部件" Then
' 部分预处理azxs + OR合并 + 括号简化(不处理 lcfw
PreprocessCondition = ApplyPreprocessingWithoutLcfw(strCondition, rowIdx)
Else
' 其他类别:不处理
PreprocessCondition = strCondition
End If
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
' 步骤1: 应用 azxs 映射
' 正则模式: (azxs)( *=|!= *)([a-zA-Z0-9]{2})
' 捕获组: key, operator, value (2位字母数字)
strCondition = ApplyRegexMapping( _
strCondition, _
"(azxs)( *=|!= *)([a-zA-Z0-9]{2})", _
g_AzxsMapping, _
rowIdx, _
"azxs" _
)
' 步骤2: 应用 lcfw 映射
' 正则模式: (lcfw)( *=|!= *)([a-zA-Z]\d{1,3})(?=[ \(\)]?)
' 捕获组: key, operator, value (字母+1-3位数字)
' 使用正向先行断言 (?=...) 确保不消耗后续字符
strCondition = ApplyRegexMapping( _
strCondition, _
"(lcfw)( *=|!= *)([a-zA-Z]\d{1,3})(?=[ \(\)]?)", _
g_LcfwMapping, _
rowIdx, _
"lcfw" _
)
' 步骤3: 递归处理嵌套括号内的表达式合并OR简化括号
strCondition = ProcessNestedExpressions(strCondition, rowIdx)
' 步骤4: 合并顶层重复的OR条件
strCondition = MergeDuplicateORConditions(strCondition)
' 步骤5: 简化不必要的括号
strCondition = SimplifyParentheses(strCondition)
ApplyPreprocessing = strCondition
End Function
' ------------------------------------------------------------------------------
' 应用预处理(不含 lcfw 映射):用于"部件"类别
' 执行步骤azxs 映射 → 嵌套表达式处理 → OR合并 → 括号简化
' ------------------------------------------------------------------------------
Private Function ApplyPreprocessingWithoutLcfw( _
ByVal strCondition As String, _
ByVal rowIdx As Long _
) As String
' 步骤1: 应用 azxs 映射
strCondition = ApplyRegexMapping( _
strCondition, _
"(azxs)( *=|!= *)([a-zA-Z0-9]{2})", _
g_AzxsMapping, _
rowIdx, _
"azxs" _
)
' 步骤2: 递归处理嵌套括号内的表达式合并OR简化括号
strCondition = ProcessNestedExpressions(strCondition, rowIdx)
' 步骤3: 合并顶层重复的OR条件
strCondition = MergeDuplicateORConditions(strCondition)
' 步骤4: 简化不必要的括号
strCondition = SimplifyParentheses(strCondition)
ApplyPreprocessingWithoutLcfw = strCondition
End Function
' ------------------------------------------------------------------------------
' 递归处理嵌套表达式先预处理括号内的内容再进行OR合并
' ------------------------------------------------------------------------------
Private Function ProcessNestedExpressions( _
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 = ProcessNestedExpressions(bracketContent, rowIdx)
' 对处理后的内容进行OR合并和简化
processedContent = MergeDuplicateORConditions(processedContent)
processedContent = SimplifyIfAllSame(processedContent)
' 重新组装:决定是否需要保留括号
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
ProcessNestedExpressions = result
End Function
' ------------------------------------------------------------------------------
' 使用正则表达式应用值映射
' ------------------------------------------------------------------------------
Private Function ApplyRegexMapping( _
ByVal strCondition As String, _
ByVal pattern As String, _
ByVal mapping As Object, _
ByVal rowIdx As Long, _
ByVal keyName As String _
) As String
' 创建 RegExp 对象 (Late Binding)
Dim regex As Object
Set regex = CreateObject("VBScript.RegExp")
With regex
.Global = True ' 全局匹配
.IgnoreCase = True ' 不区分大小写
.Pattern = pattern
End With
' 执行匹配
Dim matches As Object
Set matches = regex.Execute(strCondition)
' 如果没有匹配,直接返回原字符串
If matches.count = 0 Then
ApplyRegexMapping = strCondition
Exit Function
End If
' 执行替换:从后向前替换,避免位置偏移问题
Dim result As String
result = strCondition
Dim i As Long
For i = matches.count - 1 To 0 Step -1
Dim match As Object
Set match = matches(i)
Dim originalValue As String
originalValue = match.SubMatches(2)
' 查询映射表
If mapping.Exists(originalValue) Then
Dim mappedValue As String
Dim replacementStr As String
mappedValue = mapping(originalValue)
' 构建替换字符串,保留原始格式(空格等)
replacementStr = match.SubMatches(0) & match.SubMatches(1) & mappedValue
' 使用正则对象的 Replace 方法进行精确替换
' 创建精确匹配当前 match 的模式
Dim exactPattern As String
exactPattern = EscapeForRegex(match.Value)
Dim exactRegex As Object
Set exactRegex = CreateObject("VBScript.RegExp")
With exactRegex
.Global = False ' 只替换第一个匹配(从后向前,每次只处理一个)
.IgnoreCase = True
.Pattern = exactPattern
End With
result = exactRegex.Replace(result, replacementStr)
Else
' 记录警告
g_Logger.Record rowIdx, "M05.PreProcessor", "Mapping Warning", _
"Value not found in mapping table: " & keyName & "=" & originalValue, match.Value
End If
Next i
ApplyRegexMapping = result
End Function
' ------------------------------------------------------------------------------
' 转义字符串用于正则表达式(转义特殊字符)
' ------------------------------------------------------------------------------
Private Function EscapeForRegex(ByVal str As String) As String
' 转义正则表达式特殊字符: . \ + * ? [ ] { } ( ) ^ $ |
Dim result As String
result = str
' 必须按顺序转义 \ 先转义
result = Replace(result, "\", "\\")
result = Replace(result, ".", "\.")
result = Replace(result, "+", "\+")
result = Replace(result, "*", "\*")
result = Replace(result, "?", "\?")
result = Replace(result, "[", "\[")
result = Replace(result, "]", "\]")
result = Replace(result, "{", "\{")
result = Replace(result, "}", "\}")
result = Replace(result, "(", "\(")
result = Replace(result, ")", "\)")
result = Replace(result, "^", "\^")
result = Replace(result, "$", "\$")
result = Replace(result, "|", "\|")
EscapeForRegex = result
End Function
' ------------------------------------------------------------------------------
' 合并重复的OR条件
' ------------------------------------------------------------------------------
Private Function MergeDuplicateORConditions( _
ByVal strCondition As String _
) As String
' 按顶层OR分割
Dim orSegments As Collection
Set orSegments = SplitTopLevel(strCondition, " OR ")
' 如果只有一个分段或没有OR直接返回
If orSegments.count <= 1 Then
MergeDuplicateORConditions = strCondition
Exit Function
End If
' 使用Dictionary去重标准化后比较
Dim uniqueSegments As Object
Set uniqueSegments = CreateObject("Scripting.Dictionary")
Dim segment As Variant
For Each segment In orSegments
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
MergeDuplicateORConditions = result
End Function
' ------------------------------------------------------------------------------
' 简化不必要的括号
' ------------------------------------------------------------------------------
Private Function SimplifyParentheses( _
ByVal strCondition As String _
) As String
strCondition = Trim(strCondition)
' 如果没有外层括号,直接返回
If Left(strCondition, 1) <> "(" Or Right(strCondition, 1) <> ")" Then
SimplifyParentheses = strCondition
Exit Function
End If
' 去掉外层括号,检查内容
Dim innerContent As String
innerContent = Mid(strCondition, 2, Len(strCondition) - 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
SimplifyParentheses = innerContent
Exit Function
End If
' 如果有OR操作符但所有分段都相同可以简化
If hasTopLevelOR And Not hasTopLevelAND Then
Dim simplified As String
simplified = SimplifyIfAllSame(innerContent)
' 如果简化后没有括号,返回简化结果
If Left(simplified, 1) <> "(" Then
SimplifyParentheses = simplified
Exit Function
End If
End If
' 保留括号
SimplifyParentheses = strCondition
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 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
' ------------------------------------------------------------------------------
' 顶层分割(尊重括号嵌套)
' ------------------------------------------------------------------------------
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
' ------------------------------------------------------------------------------
' 标准化空白字符
' ------------------------------------------------------------------------------
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
' ------------------------------------------------------------------------------
' 测试辅助函数获取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