admin/AutoBOM
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refactor: rename VBA directory to VBA_BOMConverter
All checks were successful
NTFY Notification / notify (push) Successful in 20s
Details

Browse Source 
Rename VBA/ directory to VBA_BOMConverter/ for better clarity.
This change reflects the module's purpose as the BOM converter component.

Co-Authored-By: Claude Sonnet 4.5 <noreply@anthropic.com>
This commit is contained in:
Misaka_Company
2026-02-11 10:11:40 +08:00
parent ec579b30b2
commit c6c31f81c8
7 changed files with 0 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

656
VBA_BOMConverter/Modules/M01_Main.bas Normal file
View File

@@ -0,0 +1,656 @@
' ==============================================================================
' 模块: M01_Main
' 职责: 程序入口，调度器，UI交互(进度条)
' ==============================================================================
Option Explicit
Public Sub RunBOMConversion()
Dim wsSrc As Worksheet
Dim arrData As Variant
Dim logger As New clsErrorLogger
Dim i As Long
' 使用 Dictionary 替代 Collection 来存储类别，方便查找
Dim catData As Object
Set catData = CreateObject("Scripting.Dictionary")
' 1. 环境初始化
On Error GoTo MainErrorHandler
'Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
' 2. 检查工作表
On Error Resume Next
Set wsSrc = ActiveWorkbook.Sheets("平台配置清单")
On Error GoTo MainErrorHandler
If wsSrc Is Nothing Then
MsgBox "错误：未找到名为 '平台配置清单' 的工作表。", vbCritical
GoTo ExitHandler
End If
' 读取数据
Application.StatusBar = "正在读取源数据..."
arrData = M02_DataIO.ReadSourceData(wsSrc)
If IsEmpty(arrData) Then
MsgBox "未找到数据。", vbExclamation
GoTo ExitHandler
End If
' 3. 初始化逻辑模块
M03_Logic.InitLogic logger
' 3.1 初始化预处理模块
Dim wsMapping As Worksheet
On Error Resume Next
Set wsMapping = ActiveWorkbook.Sheets("对照表")
On Error GoTo MainErrorHandler
If wsMapping Is Nothing Then
MsgBox "警告：未找到 [对照表] 工作表，预处理功能将禁用。", vbExclamation
Else
M05_PreProcessor.InitPreProcessor logger, wsMapping
End If
' 4. 主循环
Dim rowIdx As Long
Dim strCat As String, strCond As String
Dim colResult As Collection
Dim itm As Variant
Dim baseInfo As Variant
Dim totalRows As Long
Dim pct As Long
totalRows = UBound(arrData, 1)
For i = 1 To totalRows
rowIdx = M04_Config.SRC_START_ROW + i - 1
strCat = Trim(CStr(arrData(i, M04_Config.COL_IDX_CAT)))
' --- 进度条更新 ---
pct = CLng((i / totalRows) * 100)
Application.StatusBar = "正在处理: " & pct & "% | 行: " & rowIdx & " | 类别: " & strCat
If i Mod 10 = 0 Then DoEvents ' 每10行刷新一次界面，防止卡顿但不过度拖慢速度
' ------------------
' 忽略空类别
If Len(strCat) > 0 Then
strCond = CStr(arrData(i, M04_Config.COL_IDX_COND))
If IsEmpty(arrData(i, M04_Config.COL_IDX_COND)) Then strCond = ""
' 4.1 预处理条件（仅对"接头"类别）
If Len(strCond) > 0 And M05_PreProcessor.IsInitialized() Then
strCond = M05_PreProcessor.PreprocessCondition(strCond, strCat, rowIdx)
End If
' 解析
Set colResult = M03_Logic.ParseRule(strCond, rowIdx)
If Not colResult Is Nothing Then
If Not catData.Exists(strCat) Then
catData.Add strCat, New Collection
End If
' 基础信息: 代号, 名称, 数量
baseInfo = Array(arrData(i, M04_Config.COL_IDX_CODE), _
arrData(i, M04_Config.COL_IDX_NAME), _
arrData(i, M04_Config.COL_IDX_QTY))
' 将展开的记录存入
For Each itm In colResult
catData(strCat).Add Array(itm, baseInfo)
Next itm
End If
End If
Next i
' 5. 输出
Application.StatusBar = "正在生成新工作簿..."
M02_DataIO.WriteCategoryToNewBook catData
' 6. 错误报告
If logger.HasErrors Then
logger.PrintReport ActiveWorkbook
MsgBox "转换完成，但发现部分数据存在逻辑冲突，已生成错误报告。", vbExclamation
End If
ExitHandler:
' 清理状态
Application.StatusBar = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Exit Sub
MainErrorHandler:
MsgBox "发生运行时错误: " & Err.Description, vbCritical
Resume ExitHandler
End Sub
' ==============================================================================
' 过程: GeneratePreprocessingReport
' 职责: 生成预处理条件转换对比报表，展示"接头"类别的条件转换结果
' ==============================================================================
Public Sub GeneratePreprocessingReport()
On Error GoTo ReportErrorHandler
Application.StatusBar = "正在生成预处理报表..."
' 1. 创建错误日志记录器
Dim logger As New clsErrorLogger
' 2. 验证工作表存在
If Not WorksheetExists("平台配置清单") Then
MsgBox "未找到[平台配置清单]工作表！", vbCritical
GoTo ReportExitHandler
End If
Dim wsSrc As Worksheet
Set wsSrc = ActiveWorkbook.Sheets("平台配置清单")
' 3. 读取源数据
Dim arrData As Variant
arrData = M02_DataIO.ReadSourceData(wsSrc)
If IsEmpty(arrData) Then
MsgBox "没有找到数据！", vbExclamation
GoTo ReportExitHandler
End If
' 4. 初始化预处理器（如果"对照表"存在）
If WorksheetExists("对照表") Then
Dim wsMapping As Worksheet
Set wsMapping = ActiveWorkbook.Sheets("对照表")
M05_PreProcessor.InitPreProcessor logger, wsMapping
End If
' 5. 处理数据并收集统计信息
Dim results As Collection
Set results = New Collection
Dim stats As Object
Set stats = CreateObject("Scripting.Dictionary")
stats("totalRows") = 0
stats("processedRows") = 0
stats("successCount") = 0
stats("warningCount") = 0
stats("emptyCount") = 0
stats("orMergeCount") = 0
' 遍历数据
Dim i As Long
For i = LBound(arrData, 1) To UBound(arrData, 1)
Dim rowIdx As Long
rowIdx = i + M04_Config.SRC_START_ROW ' 原始表行号
Dim strCat As String
strCat = CStr(arrData(i, M04_Config.COL_IDX_CAT))
' 只处理"接头"类别
If strCat = "接头" Then
stats("processedRows") = stats("processedRows") + 1
' 提取数据
Dim strCode As String, strName As String
Dim strQty As String, strOrigCond As String
strCode = CStr(arrData(i, M04_Config.COL_IDX_CODE))
strName = CStr(arrData(i, M04_Config.COL_IDX_NAME))
strQty = CStr(arrData(i, M04_Config.COL_IDX_QTY))
strOrigCond = CStr(arrData(i, M04_Config.COL_IDX_COND))
' 调用预处理器
Dim strConvCond As String
strConvCond = M05_PreProcessor.PreprocessCondition(strOrigCond, strCat, rowIdx)
' 分析转换
Dim strDetails As String
Dim strStatus As String
Dim nORMerges As Long
Dim strMappingDetails As String
strDetails = AnalyzeConversion(strOrigCond, strConvCond, nORMerges)
strStatus = DetermineStatus(strOrigCond, strConvCond, strCat)
strMappingDetails = ExtractMappingDetails(strOrigCond, strConvCond)
' 更新统计
If strStatus = "成功" Then stats("successCount") = stats("successCount") + 1
If strStatus = "警告" Then stats("warningCount") = stats("warningCount") + 1
If strStatus = "空条件" Then stats("emptyCount") = stats("emptyCount") + 1
stats("orMergeCount") = stats("orMergeCount") + nORMerges
' 添加到结果集合（11列：行号, 代号, 名称, 数量, 类别, 原始条件, 转换后条件, 映射详情, 转换说明, 状态, 错误/警告）
results.Add Array(rowIdx, strCode, strName, strQty, strCat, _
strOrigCond, strConvCond, strMappingDetails, strDetails, strStatus, "")
End If
Next i
' 6. 创建或清除工作表
Dim wsReport As Worksheet
On Error Resume Next
Set wsReport = ActiveWorkbook.Sheets("条件转换对比表")
On Error GoTo ReportErrorHandler
If wsReport Is Nothing Then
Set wsReport = ActiveWorkbook.Worksheets.Add(After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.count))
wsReport.Name = "条件转换对比表"
Else
wsReport.Cells.Clear
End If
' 7. 写入统计信息（第1-6行）
wsReport.Cells(1, 1).Value = "总处理行数: " & stats("processedRows")
wsReport.Cells(2, 1).Value = "转换成功数: " & stats("successCount")
wsReport.Cells(3, 1).Value = "警告数: " & stats("warningCount")
wsReport.Cells(4, 1).Value = "空条件行数: " & stats("emptyCount")
wsReport.Cells(5, 1).Value = "OR条件合并次数: " & stats("orMergeCount")
' 8. 写入表头（第8行）
Dim headers As Variant
headers = Array("行号", "代号", "名称", "数量", "类别", _
"原始条件", "转换后条件", "映射详情", "转换说明", "状态", "错误/警告")
Dim col As Long
For col = 1 To 11
wsReport.Cells(8, col).Value = headers(col - 1)
Next col
' 9. 批量写入数据（从第9行开始）
If results.count > 0 Then
Dim arrOutput() As Variant
ReDim arrOutput(1 To results.count, 1 To 11)
Dim j As Long
j = 1
Dim result As Variant
For Each result In results
Dim k As Long
For k = 1 To 11
arrOutput(j, k) = result(k - 1)
Next k
j = j + 1
Next result
wsReport.Range("A9").Resize(results.count, 11).Value = arrOutput
End If
' 10. 格式化工作表
Call FormatReportWorksheet(wsReport, results.count)
Application.StatusBar = False
MsgBox "预处理报表生成完成！", vbInformation
Exit Sub
ReportErrorHandler:
Application.StatusBar = False
MsgBox "生成报表时出错：" & vbCrLf & _
"错误 " & Err.Number & ": " & Err.Description, _
vbCritical, "报表生成错误"
ReportExitHandler:
Application.StatusBar = False
End Sub
' ==============================================================================
' 辅助函数: FormatReportWorksheet
' 职责: 格式化报表工作表
' ==============================================================================
Private Sub FormatReportWorksheet(ByVal wsReport As Worksheet, ByVal rowCount As Long)
' 1. 格式化统计区域
With wsReport.Range("A1:A6")
.Font.Bold = True
.Font.Size = 11
.Interior.Color = RGB(200, 220, 255)
End With
' 2. 格式化表头
With wsReport.Range("A8:K8")
.Font.Bold = True
.Interior.Color = RGB(217, 217, 217)
.HorizontalAlignment = xlCenter
End With
' 3. 格式化状态列和映射详情列（根据值着色）
Dim lastRow As Long
lastRow = 8 + rowCount
If rowCount > 0 Then
Dim r As Long
For r = 9 To lastRow
' 映射详情列（第8列，H列）- 有映射时使用浅绿色背景
If Len(wsReport.Cells(r, 8).Value) > 0 Then
wsReport.Cells(r, 8).Interior.Color = RGB(230, 255, 230)
wsReport.Cells(r, 8).Font.Color = RGB(0, 100, 0)
wsReport.Cells(r, 8).Font.Italic = True
End If
' 状态列（第10列，J列）
Select Case wsReport.Cells(r, 10).Value
Case "成功"
wsReport.Cells(r, 10).Interior.Color = RGB(200, 255, 200)
Case "警告"
wsReport.Cells(r, 10).Interior.Color = RGB(255, 255, 200)
Case "未转换"
wsReport.Cells(r, 10).Interior.Color = RGB(240, 240, 240)
Case "空条件"
wsReport.Cells(r, 10).Interior.Color = RGB(220, 240, 255)
End Select
Next r
' 4. 应用边框
With wsReport.Range("A8:K" & lastRow)
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
End With
End If
' 5. 自动调整列宽
wsReport.Columns.AutoFit
' 6. 设置文本换行
wsReport.Columns("F:K").WrapText = True
' 7. 冻结窗格
wsReport.Activate
ActiveWindow.FreezePanes = False
wsReport.Rows(9).Select
ActiveWindow.FreezePanes = True
' 8. 选中和取消选中，避免选区
wsReport.Cells(1, 1).Select
End Sub
' ==============================================================================
' 辅助函数: AnalyzeConversion
' 职责: 分析转换内容，返回说明字符串
' ==============================================================================
Private Function AnalyzeConversion( _
ByVal strOrig As String, _
ByVal strConv As String, _
ByRef outORMerges As Long _
) As String
Dim details As Collection
Set details = New Collection
' 计算OR合并次数
Dim origORCount As Long, convORCount As Long
origORCount = CountOccurrences(strOrig, " OR ")
convORCount = CountOccurrences(strConv, " OR ")
outORMerges = origORCount - convORCount
If outORMerges > 0 Then details.Add "OR合并:" & outORMerges & "次"
' 检测azxs映射
If ContainsAzxsChange(strOrig, strConv) Then
details.Add "azxs值映射"
End If
' 检测lcfw映射
If ContainsLcfwChange(strOrig, strConv) Then
details.Add "lcfw值映射"
End If
' 检测括号简化
If CountOccurrences(strOrig, "(") > CountOccurrences(strConv, "(") Then
details.Add "括号简化"
End If
' 组合说明
If details.count = 0 Then
AnalyzeConversion = "无变化"
Else
Dim result As String
result = ""
Dim item As Variant
For Each item In details
If Len(result) > 0 Then result = result & " + "
result = result & item
Next item
AnalyzeConversion = result
End If
End Function
' ==============================================================================
' 辅助函数: DetermineStatus
' 职责: 确定转换状态
' ==============================================================================
Private Function DetermineStatus( _
ByVal strOrig As String, _
ByVal strConv As String, _
ByVal strCat As String _
) As String
If Len(Trim(strOrig)) = 0 Then
DetermineStatus = "空条件"
ElseIf strCat <> "接头" Then
DetermineStatus = "未转换"
ElseIf strOrig <> strConv Then
DetermineStatus = "成功"
Else
DetermineStatus = "未转换"
End If
End Function
' ==============================================================================
' 辅助函数: CountOccurrences
' 职责: 计算子字符串在字符串中出现的次数
' ==============================================================================
Private Function CountOccurrences( _
ByVal strText As String, _
ByVal strFind As String _
) As Long
If Len(strText) = 0 Or Len(strFind) = 0 Then
CountOccurrences = 0
Exit Function
End If
CountOccurrences = (Len(strText) - Len(Replace(strText, strFind, ""))) / Len(strFind)
End Function
' ==============================================================================
' 辅助函数: ContainsAzxsChange
' 职责: 使用正则表达式检查azxs值是否变化
' ==============================================================================
Private Function ContainsAzxsChange( _
ByVal strOrig As String, _
ByVal strConv As String _
) As Boolean
' 使用正则表达式检查azxs值是否变化
Dim regex As Object
Set regex = CreateObject("VBScript.RegExp")
regex.Global = True
regex.IgnoreCase = True
regex.Pattern = "(azxs)( *=|!= *)([a-zA-Z0-9]{2})"
' 提取原始azxs值
Dim origMatches As Object
Set origMatches = regex.Execute(strOrig)
' 提取转换后azxs值
Dim convMatches As Object
Set convMatches = regex.Execute(strConv)
' 如果数量不同，说明有变化
If origMatches.count <> convMatches.count Then
ContainsAzxsChange = True
Exit Function
End If
' 比较值
Dim i As Long
For i = 0 To origMatches.count - 1
If origMatches(i).SubMatches(2) <> convMatches(i).SubMatches(2) Then
ContainsAzxsChange = True
Exit Function
End If
Next i
ContainsAzxsChange = False
End Function
' ==============================================================================
' 辅助函数: ContainsLcfwChange
' 职责: 使用正则表达式检查lcfw值是否变化
' ==============================================================================
Private Function ContainsLcfwChange( _
ByVal strOrig As String, _
ByVal strConv As String _
) As Boolean
' 使用正则表达式检查lcfw值是否变化
Dim regex As Object
Set regex = CreateObject("VBScript.RegExp")
regex.Global = True
regex.IgnoreCase = True
regex.Pattern = "(lcfw)( *=|!= *)([a-zA-Z]\d{1,3})"
' 提取原始lcfw值
Dim origMatches As Object
Set origMatches = regex.Execute(strOrig)
' 提取转换后lcfw值
Dim convMatches As Object
Set convMatches = regex.Execute(strConv)
' 如果数量不同，说明有变化
If origMatches.count <> convMatches.count Then
ContainsLcfwChange = True
Exit Function
End If
' 比较值
Dim i As Long
For i = 0 To origMatches.count - 1
If origMatches(i).SubMatches(2) <> convMatches(i).SubMatches(2) Then
ContainsLcfwChange = True
Exit Function
End If
Next i
ContainsLcfwChange = False
End Function
' ==============================================================================
' 辅助函数: ExtractMappingDetails
' 职责: 提取并生成映射详情字符串
' ==============================================================================
Private Function ExtractMappingDetails( _
ByVal strOrig As String, _
ByVal strConv As String _
) As String
Dim mappings As Collection
Set mappings = New Collection
' 提取 azxs 映射
Dim azxsMappings As String
azxsMappings = ExtractFieldMappings(strOrig, strConv, "azxs", "(azxs)( *=|!= *)([a-zA-Z0-9]{2})")
If Len(azxsMappings) > 0 Then
mappings.Add azxsMappings
End If
' 提取 lcfw 映射
Dim lcfwMappings As String
lcfwMappings = ExtractFieldMappings(strOrig, strConv, "lcfw", "(lcfw)( *=|!= *)([a-zA-Z]\d{1,3})")
If Len(lcfwMappings) > 0 Then
mappings.Add lcfwMappings
End If
' 组合所有映射（使用换行符分隔）
If mappings.count = 0 Then
ExtractMappingDetails = ""
ElseIf mappings.count = 1 Then
ExtractMappingDetails = mappings(1)
Else
Dim result As String
result = ""
Dim item As Variant
For Each item In mappings
If Len(result) > 0 Then result = result & vbLf
result = result & item
Next item
ExtractMappingDetails = result
End If
End Function
' ==============================================================================
' 辅助函数: ExtractFieldMappings
' 职责: 提取特定字段的映射详情
' ==============================================================================
Private Function ExtractFieldMappings( _
ByVal strOrig As String, _
ByVal strConv As String, _
ByVal fieldName As String, _
ByVal pattern As String _
) As String
' 使用正则表达式提取字段映射
Dim regex As Object
Set regex = CreateObject("VBScript.RegExp")
regex.Global = True
regex.IgnoreCase = True
regex.Pattern = pattern
' 从原始条件中提取所有该字段的值
Dim origMatches As Object
Set origMatches = regex.Execute(strOrig)
' 如果原始条件中没有匹配，返回空
If origMatches.count = 0 Then
ExtractFieldMappings = ""
Exit Function
End If
' 收集所有唯一的映射
Dim mappingDict As Object
Set mappingDict = CreateObject("Scripting.Dictionary")
Dim i As Long
For i = 0 To origMatches.count - 1
Dim origValue As String
Dim mappedValue As String
origValue = origMatches(i).SubMatches(2)
' 根据字段名查询映射表
If LCase(fieldName) = "azxs" Then
mappedValue = M05_PreProcessor.GetAzxsMappedValue(origValue)
ElseIf LCase(fieldName) = "lcfw" Then
mappedValue = M05_PreProcessor.GetLcfwMappedValue(origValue)
Else
mappedValue = ""
End If
' 只有当找到映射且值发生变化时才记录
If Len(mappedValue) > 0 And origValue <> mappedValue Then
Dim mapKey As String
mapKey = fieldName & "=" & origValue & " → " & fieldName & "=" & mappedValue
' 去重
If Not mappingDict.Exists(mapKey) Then
mappingDict.Add mapKey, mapKey
End If
End If
Next i
' 组合结果
If mappingDict.count = 0 Then
ExtractFieldMappings = ""
Else
Dim result As String
result = ""
Dim key As Variant
For Each key In mappingDict.keys
If Len(result) > 0 Then result = result & vbLf
result = result & key
Next key
ExtractFieldMappings = result
End If
End Function
' ==============================================================================
' 辅助函数: WorksheetExists
' 职责: 检查工作表是否存在
' ==============================================================================
Private Function WorksheetExists(ByVal sheetName As String) As Boolean
On Error Resume Next
Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets(sheetName)
WorksheetExists = Not ws Is Nothing
On Error GoTo 0
End Function

160
VBA_BOMConverter/Modules/M02_DataIO.bas Normal file
View File

@@ -0,0 +1,160 @@
' ==============================================================================
' 模块: M02_DataIO
' 职责: 数据读写
' ==============================================================================
Option Explicit
Public Function ReadSourceData(ws As Worksheet) As Variant
Dim lastRow As Long
' 查找C列最后一行
lastRow = ws.Cells(ws.Rows.count, M04_Config.COL_IDX_CODE).End(xlUp).row
If lastRow < M04_Config.SRC_START_ROW Then
ReadSourceData = Empty
Exit Function
End If
' 读取整张表的数据区域 (假设列数不超过20列，足以覆盖到类别列)
ReadSourceData = ws.Range(ws.Cells(M04_Config.SRC_START_ROW, 1), ws.Cells(lastRow, M04_Config.COL_IDX_CAT)).Value
End Function
Public Sub WriteCategoryToNewBook(catData As Object)
Dim newWb As Workbook
Dim ws As Worksheet
Dim catName As Variant
Dim colRows As Collection
Dim finalArr() As Variant
Dim headerKeys As Collection
Dim i As Long, r As Long, c As Long
Dim rowDict As Object
Dim key As Variant
If catData.count = 0 Then Exit Sub
Set newWb = Workbooks.Add
For Each catName In catData.keys
Set colRows = catData(catName)
If colRows.count > 0 Then
' 创建新Sheet
Set ws = newWb.Worksheets.Add
ws.Name = CleanSheetName(CStr(catName))
' 1. 扫描该类别所有Key
Dim allKeysDict As Object
Set allKeysDict = CreateObject("Scripting.Dictionary")
For i = 1 To colRows.count
' colRows(i) 是一个 Array(Dict, BaseInfoArr)
Set rowDict = colRows(i)(0)
For Each key In rowDict.keys
If Not allKeysDict.Exists(key) Then allKeysDict.Add key, 0
Next key
Next i
' 2. 排序Key
Dim sortedHeaders() As String
sortedHeaders = SortHeaders(allKeysDict.keys)
' 3. 准备输出数组
Dim condCount As Long
condCount = UBound(sortedHeaders) - LBound(sortedHeaders) + 1
' 检查是否为空数组（如果全是无条件的物料）
If sortedHeaders(0) = "" And condCount = 1 Then condCount = 0
Dim totalCols As Long
totalCols = condCount + 3 ' 条件列 + 名称/编码/数量
ReDim finalArr(1 To colRows.count + 1, 1 To totalCols)
' 3.1 写表头
Dim colOffset As Long
colOffset = 0
If condCount > 0 Then
For c = 0 To condCount - 1
finalArr(1, c + 1) = sortedHeaders(c)
Next c
colOffset = condCount
End If
finalArr(1, colOffset + 1) = "名称"
finalArr(1, colOffset + 2) = "编码"
finalArr(1, colOffset + 3) = "数量"
' 3.2 填充内容
For r = 1 To colRows.count
Dim baseInfo As Variant
Set rowDict = colRows(r)(0)
baseInfo = colRows(r)(1) ' Array: Code, Name, Qty
' 填条件
If condCount > 0 Then
For c = 0 To condCount - 1
key = sortedHeaders(c)
If rowDict.Exists(key) Then
finalArr(r + 1, c + 1) = rowDict(key)
End If
Next c
End If
' 填基础信息
finalArr(r + 1, colOffset + 1) = baseInfo(1) ' Name
finalArr(r + 1, colOffset + 2) = baseInfo(0) ' Code
finalArr(r + 1, colOffset + 3) = baseInfo(2) ' Qty
Next r
' 4. 写入Excel
ws.Range("A1").Resize(UBound(finalArr, 1), UBound(finalArr, 2)).Value = finalArr
ws.Range("A1").Resize(1, totalCols).Font.Bold = True
ws.Columns.AutoFit
End If
Next catName
MsgBox "处理完成！", vbInformation
End Sub
Private Function SortHeaders(keys As Variant) As String()
' 冒泡排序
Dim i As Long, j As Long
Dim temp As String
Dim arr() As String
Dim count As Long
count = UBound(keys) - LBound(keys) + 1
If count = 0 Then
ReDim arr(0 To 0)
arr(0) = ""
SortHeaders = arr
Exit Function
End If
ReDim arr(0 To count - 1)
For i = 0 To count - 1
arr(i) = keys(i)
Next i
For i = LBound(arr) To UBound(arr) - 1
For j = i + 1 To UBound(arr)
If M04_Config.GetHeaderPriority(arr(i)) > M04_Config.GetHeaderPriority(arr(j)) Then
temp = arr(i)
arr(i) = arr(j)
arr(j) = temp
End If
Next j
Next i
SortHeaders = arr
End Function
Private Function CleanSheetName(s As String) As String
Dim invalid As String, i As Long
invalid = ":\/?*[]"
CleanSheetName = s
For i = 1 To Len(invalid)
CleanSheetName = Replace(CleanSheetName, Mid(invalid, i, 1), "_")
Next i
If Len(CleanSheetName) > 31 Then CleanSheetName = Left(CleanSheetName, 31)
End Function

289
VBA_BOMConverter/Modules/M03_Logic.bas Normal file
View File

@@ -0,0 +1,289 @@
' ==============================================================================
' 模块: M03_Logic
' 职责: 核心算法。使用后期绑定(Late Binding)避免引用错误。
' ==============================================================================
Option Explicit
Private g_Logger As clsErrorLogger
' 初始化日志引用
Public Sub InitLogic(logger As clsErrorLogger)
Set g_Logger = logger
End Sub
' ------------------------------------------------------------------------------
' 主入口: 解析规则字符串
' 返回: Collection (包含多个 Dictionary 对象)
' ------------------------------------------------------------------------------
Public Function ParseRule(strRule As String, rowIdx As Long) As Collection
On Error GoTo ErrorHandler
Dim cleanStr As String
cleanStr = CleanString(strRule)
' 空条件处理
If Len(cleanStr) = 0 Then
Dim col As New Collection
' 创建一个空字典
col.Add CreateObject("Scripting.Dictionary")
Set ParseRule = col
Exit Function
End If
Set ParseRule = RecursiveParse(cleanStr, rowIdx)
Exit Function
ErrorHandler:
g_Logger.Record rowIdx, "M03.ParseRule", "System Error", Err.Description, strRule
Set ParseRule = Nothing
End Function
' ------------------------------------------------------------------------------
' 递归解析核心
' ------------------------------------------------------------------------------
Private Function RecursiveParse(strExpr As String, rowIdx As Long) As Collection
Dim splitIdx As Long
' 1. 查找顶层 OR (最低优先级，先拆分)
splitIdx = FindSplitIndex(strExpr, "OR")
If splitIdx > 0 Then
Dim leftRes As Collection, rightRes As Collection
' 递归左边
Set leftRes = RecursiveParse(Trim(Left(strExpr, splitIdx - 1)), rowIdx)
' 递归右边 (+2 是 OR 的长度)
Set rightRes = RecursiveParse(Trim(Mid(strExpr, splitIdx + 2)), rowIdx)
' 合并结果 (Union)
Set RecursiveParse = UnionCollections(leftRes, rightRes)
Exit Function
End If
' 2. 查找顶层 AND
splitIdx = FindSplitIndex(strExpr, "AND")
If splitIdx > 0 Then
Dim leftCol As Collection, rightCol As Collection
' 递归左边
Set leftCol = RecursiveParse(Trim(Left(strExpr, splitIdx - 1)), rowIdx)
' 递归右边 (+3 是 AND 的长度)
Set rightCol = RecursiveParse(Trim(Mid(strExpr, splitIdx + 3)), rowIdx)
' 笛卡尔积 (Intersection/Merge)
Set RecursiveParse = CartesianProduct(leftCol, rightCol, rowIdx)
Exit Function
End If
' 3. 去除外层括号
If Left(strExpr, 1) = "(" And Right(strExpr, 1) = ")" Then
' 防止像 (A) AND (B) 这种情况被误去括号，但这里已经被 FindSplitIndex 过滤了顶层操作符，
' 所以如果这里首尾是括号，且中间没有暴露的操作符，说明是包裹的整体，例如 ((A AND B))
Set RecursiveParse = RecursiveParse(Mid(strExpr, 2, Len(strExpr) - 2), rowIdx)
Exit Function
End If
' 4. 原子解析 (Base Case)
Set RecursiveParse = ParseAtom(strExpr, rowIdx)
End Function
' ------------------------------------------------------------------------------
' 原子解析: key=val 或 key!=val
' ------------------------------------------------------------------------------
Private Function ParseAtom(strAtom As String, rowIdx As Long) As Collection
Dim dict As Object ' Late Binding
Set dict = CreateObject("Scripting.Dictionary")
Dim p As Long
Dim key As String, val As String
' 移除多余空格，但保留值中间可能存在的(虽然通常没有)
strAtom = Trim(strAtom)
If InStr(strAtom, "!=") > 0 Then
p = InStr(strAtom, "!=")
key = Trim(Left(strAtom, p - 1))
val = Trim(Mid(strAtom, p + 2))
dict.Add key, "!=" & val
ElseIf InStr(strAtom, "=") > 0 Then
p = InStr(strAtom, "=")
key = Trim(Left(strAtom, p - 1))
val = Trim(Mid(strAtom, p + 1))
dict.Add key, val
Else
' 无法解析的格式
If Len(strAtom) > 0 Then
g_Logger.Record rowIdx, "M03.ParseAtom", "Syntax Error", "No = or != found", strAtom
End If
End If
Dim col As New Collection
col.Add dict
Set ParseAtom = col
End Function
' ------------------------------------------------------------------------------
' 笛卡尔积: AND 逻辑
' ------------------------------------------------------------------------------
Private Function CartesianProduct(col1 As Collection, col2 As Collection, rowIdx As Long) As Collection
Dim res As New Collection
Dim d1 As Object, d2 As Object
Dim merged As Object
Dim i As Long, j As Long
If col1 Is Nothing Or col2 Is Nothing Then
Set CartesianProduct = Nothing
Exit Function
End If
For i = 1 To col1.count
For j = 1 To col2.count
Set d1 = col1(i)
Set d2 = col2(j)
Set merged = MergeDictionaries(d1, d2, rowIdx)
If Not merged Is Nothing Then
res.Add merged
End If
Next j
Next i
Set CartesianProduct = res
End Function
' ------------------------------------------------------------------------------
' 集合合并: OR 逻辑
' ------------------------------------------------------------------------------
Private Function UnionCollections(col1 As Collection, col2 As Collection) As Collection
Dim res As New Collection
Dim item As Variant
If Not col1 Is Nothing Then
For Each item In col1
res.Add item
Next item
End If
If Not col2 Is Nothing Then
For Each item In col2
res.Add item
Next item
End If
Set UnionCollections = res
End Function
' ------------------------------------------------------------------------------
' 字典合并 (处理冲突和 !=)
' ------------------------------------------------------------------------------
Private Function MergeDictionaries(d1 As Object, d2 As Object, rowIdx As Long) As Object
Dim res As Object
Set res = CreateObject("Scripting.Dictionary")
Dim k As Variant
Dim v1 As String, v2 As String
' 复制 d1
For Each k In d1.keys
res.Add k, d1(k)
Next k
' 合并 d2
For Each k In d2.keys
If res.Exists(k) Then
v1 = CStr(res(k))
v2 = CStr(d2(k))
If v1 = v2 Then
' 相同，无视
ElseIf Left(v1, 2) = "!=" And Left(v2, 2) = "!=" Then
' 都是不等于，合并
res(k) = v1 & "," & v2
ElseIf Left(v1, 2) = "!=" And Left(v2, 2) <> "!=" Then
' v1!=, v2=
If v2 = Mid(v1, 3) Then
g_Logger.Record rowIdx, "M03.Conflict", "Logic Conflict", "Equals disallowed value", k & ": " & v1 & " AND " & v2
Set MergeDictionaries = Nothing: Exit Function
Else
res(k) = v2
End If
ElseIf Left(v1, 2) <> "!=" And Left(v2, 2) = "!=" Then
' v1=, v2!=
If v1 = Mid(v2, 3) Then
g_Logger.Record rowIdx, "M03.Conflict", "Logic Conflict", "Equals disallowed value", k & ": " & v1 & " AND " & v2
Set MergeDictionaries = Nothing: Exit Function
Else
res(k) = v1
End If
Else
' 都是等于，但值不同
g_Logger.Record rowIdx, "M03.Conflict", "Logic Conflict", "Mutually Exclusive", k & "=" & v1 & " AND " & v2
Set MergeDictionaries = Nothing: Exit Function
End If
Else
res.Add k, d2(k)
End If
Next k
Set MergeDictionaries = res
End Function
' ------------------------------------------------------------------------------
' 查找逻辑分割点 (忽略括号内容)
' ------------------------------------------------------------------------------
Private Function FindSplitIndex(strExpr As String, delimiter As String) As Long
Dim i As Long
Dim bracketLevel As Long
Dim subStr As String
Dim lenDelim As Long
Dim checkStr As String
bracketLevel = 0
lenDelim = Len(delimiter)
' 预处理：为了防止匹配到变量名里的字符，我们检查 " AND " (带空格)
' 或者简单起见，我们假设变量名不包含 AND/OR 且大小写敏感
' 这里采用严格括号计数
For i = 1 To Len(strExpr) - lenDelim + 1
subStr = Mid(strExpr, i, 1)
If subStr = "(" Then
bracketLevel = bracketLevel + 1
ElseIf subStr = ")" Then
bracketLevel = bracketLevel - 1
ElseIf bracketLevel = 0 Then
' 只有在第0层括号时才匹配逻辑符
checkStr = Mid(strExpr, i, lenDelim)
' 关键修正：确保匹配的是独立单词，而不是变量名的一部分
' 简单判断：前后字符是空格，或者处于字符串边界
If UCase(checkStr) = delimiter Then
Dim isWord As Boolean
isWord = True
' 检查前一个字符
If i > 1 Then
If Mid(strExpr, i - 1, 1) <> " " And Mid(strExpr, i - 1, 1) <> ")" Then isWord = False
End If
' 检查后一个字符
If i + lenDelim <= Len(strExpr) Then
If Mid(strExpr, i + lenDelim, 1) <> " " And Mid(strExpr, i + lenDelim, 1) <> "(" Then isWord = False
End If
If isWord Then
FindSplitIndex = i
Exit Function
End If
End If
End If
Next i
FindSplitIndex = 0
End Function
Private Function CleanString(s As String) As String
' 移除多余的空格，将换行符替换为空格
Dim temp As String
temp = Replace(s, vbCrLf, " ")
temp = Replace(temp, vbCr, " ")
temp = Replace(temp, vbLf, " ")
temp = Trim(temp)
CleanString = temp
End Function

37
VBA_BOMConverter/Modules/M04_Config.bas Normal file
View File

@@ -0,0 +1,37 @@
' ==============================================================================
' 模块: M04_Config
' 职责: 系统配置、常量定义
' ==============================================================================
Option Explicit
' 源数据列号定义 (根据你的描述)
Public Const COL_IDX_CODE As Long = 3 ' 代号 (C列)
Public Const COL_IDX_NAME As Long = 4 ' 名称 (D列)
Public Const COL_IDX_QTY As Long = 5 ' 数量 (E列)
Public Const COL_IDX_COND As Long = 6 ' 选择条件 (F列)
Public Const COL_IDX_CAT As Long = 8 ' 类别 (H列)
Public Const SRC_START_ROW As Long = 4 ' 数据起始行
' 获取表头排序索引 (越小越靠前)
Public Function GetHeaderPriority(key As String) As Long
Dim vList As Variant
Dim i As Long
' 定义标准排序顺序
vList = Array("azxs", "bkxs", "gclj", "jycz", "lcdw", "lcfw", _
"fjgn", "btcy", "bp", "dskd", "nqlc", "bptx", _
"jddj", "cpdm", "tsjz", "tsyq", "bpts", "kdxh")
Dim sKey As String
sKey = LCase(Trim(key))
For i = LBound(vList) To UBound(vList)
If sKey = LCase(vList(i)) Then
GetHeaderPriority = i
Exit Function
End If
Next i
' 未知变量排在最后
GetHeaderPriority = 999
End Function

632
VBA_BOMConverter/Modules/M05_PreProcessor.bas Normal file
View File

@@ -0,0 +1,632 @@
' ==============================================================================
' 模块: 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

493
VBA_BOMConverter/Modules/M99_TestRunner.bas Normal file
View File

@@ -0,0 +1,493 @@
' ==============================================================================
' 模块: M99_TestRunner
' 职责: 单元测试，验证 M03_Logic 的核心算法
' 依赖: M03_Logic, clsErrorLogger (无需引用 Scripting Runtime)
' ==============================================================================
Option Explicit
Private m_Logger As clsErrorLogger
Private m_FailCount As Long
Private m_PassCount As Long
Private m_wsMapping As Worksheet ' 用于测试的映射表工作表
' ------------------------------------------------------------------------------
' 主入口: 运行所有测试
' ------------------------------------------------------------------------------
Public Sub RunAllTests()
' 初始化环境
Set m_Logger = New clsErrorLogger
M03_Logic.InitLogic m_Logger
m_FailCount = 0
m_PassCount = 0
Debug.Print String(50, "=")
Debug.Print "开始运行单元测试: " & Now
Debug.Print String(50, "-")
' 执行测试用例
Test_01_SimpleAtom
Test_02_SimpleAND
Test_03_SimpleOR
Test_04_CartesianProduct ' 核心：测试 (A OR B) AND C
Test_05_InequalityMerge ' 核心：测试 !=A AND !=B
Test_06_LogicConflict ' 核心：测试 A=1 AND A=2
Test_07_ComplexNested ' 核心：多层括号
' 新增预处理测试
Debug.Print String(50, "-")
Debug.Print "新增预处理测试:"
Debug.Print String(50, "-")
Test_PP_01_AzxsMappingLoad
Test_PP_02_LcfwMappingLoad
Test_PP_03_AzxsReplacement
Test_PP_04_LcfwReplacement
Test_PP_05_ORMerging
Test_PP_06_FullIntegration
Test_PP_07_NonJointCategory
Test_PP_08_UnmappedValues
Test_PP_09_ComponentCategory_AzxsMapping
Test_PP_10_ComponentCategory_LcfwUnchanged
Test_PP_11_ComponentCategory_ORMerging
Test_PP_12_ComponentCategory_ParenthesesSimplification
' 汇总结果
Debug.Print String(50, "-")
If m_FailCount = 0 Then
Debug.Print "测试结果: ALL PASS! (共 " & m_PassCount & " 个测试点)"
Else
Debug.Print "测试结果: 失败 " & m_FailCount & " 个, 通过 " & m_PassCount & " 个"
End If
Debug.Print String(50, "=")
End Sub
' ------------------------------------------------------------------------------
' 测试用例 01: 简单赋值
' 输入: gclj=M20
' 期望: 1行数据, gclj字段为M20
' ------------------------------------------------------------------------------
Private Sub Test_01_SimpleAtom()
Dim col As Collection
Dim row As Object ' Dictionary
Set col = M03_Logic.ParseRule("gclj=M20", 1)
Assert_NotNull col, "T01_Col_Not_Null"
Assert_Equal col.count, 1, "T01_Count"
Set row = col(1)
Assert_Equal row("gclj"), "M20", "T01_Value_Check"
End Sub
' ------------------------------------------------------------------------------
' 测试用例 02: AND 逻辑 (属性合并)
' 输入: gclj=M20 AND jycz=1
' 期望: 1行数据, 包含两个字段
' ------------------------------------------------------------------------------
Private Sub Test_02_SimpleAND()
Dim col As Collection
Dim row As Object
Set col = M03_Logic.ParseRule("gclj=M20 AND jycz=1", 2)
Assert_Equal col.count, 1, "T02_Count"
Set row = col(1)
Assert_Equal row("gclj"), "M20", "T02_Key1"
Assert_Equal row("jycz"), "1", "T02_Key2"
End Sub
' ------------------------------------------------------------------------------
' 测试用例 03: OR 逻辑 (记录分裂)
' 输入: azxs=A0 OR azxs=A1
' 期望: 2行数据
' ------------------------------------------------------------------------------
Private Sub Test_03_SimpleOR()
Dim col As Collection
Set col = M03_Logic.ParseRule("azxs=A0 OR azxs=A1", 3)
Assert_Equal col.count, 2, "T03_Count"
End Sub
' ------------------------------------------------------------------------------
' 测试用例 04: 笛卡尔积 (AND 连接 OR)
' 输入: gclj=M20 AND (azxs=A0 OR azxs=A1)
' 期望: 2行数据。行1(gclj=M20, azxs=A0), 行2(gclj=M20, azxs=A1)
' ------------------------------------------------------------------------------
Private Sub Test_04_CartesianProduct()
Dim col As Collection
Dim r1 As Object, r2 As Object
Set col = M03_Logic.ParseRule("gclj=M20 AND (azxs=A0 OR azxs=A1)", 4)
Assert_Equal col.count, 2, "T04_Count"
Set r1 = col(1)
Set r2 = col(2)
' 验证公共部分
Assert_Equal r1("gclj"), "M20", "T04_Row1_Common"
Assert_Equal r2("gclj"), "M20", "T04_Row2_Common"
' 验证差异部分
Dim hasA0 As Boolean, hasA1 As Boolean
If r1("azxs") = "A0" Or r2("azxs") = "A0" Then hasA0 = True
If r1("azxs") = "A1" Or r2("azxs") = "A1" Then hasA1 = True
Assert_Equal hasA0, True, "T04_Has_A0"
Assert_Equal hasA1, True, "T04_Has_A1"
End Sub
' ------------------------------------------------------------------------------
' 测试用例 05: 不等于逻辑合并
' 输入: gclj!=M20 AND gclj!=M30
' 期望: 1行数据, gclj字段为 "!=M20,!=M30"
' ------------------------------------------------------------------------------
Private Sub Test_05_InequalityMerge()
Dim col As Collection
Dim row As Object
Set col = M03_Logic.ParseRule("gclj!=M20 AND gclj!=M30", 5)
Assert_Equal col.count, 1, "T05_Count"
Set row = col(1)
Assert_Equal row("gclj"), "!=M20,!=M30", "T05_Value_Merge"
End Sub
' ------------------------------------------------------------------------------
' 测试用例 06: 逻辑冲突检测 (修正版)
' 输入: gclj=M20 AND gclj=M30
' 期望: 返回 Nothing 或 空集合，且 Logger 中有记录
' ------------------------------------------------------------------------------
Private Sub Test_06_LogicConflict()
Dim col As Collection
' 重置 Logger
Set m_Logger = New clsErrorLogger
M03_Logic.InitLogic m_Logger
' 此时 ParseRule 内部会捕捉冲突
Set col = M03_Logic.ParseRule("gclj=M20 AND gclj=M30", 6)
' 检查结果: 应该是 Nothing 或者 Count=0
Dim isInvalid As Boolean
If col Is Nothing Then
isInvalid = True
Else
If col.count = 0 Then isInvalid = True Else isInvalid = False
End If
Assert_Equal isInvalid, True, "T06_Should_Return_Empty_Or_Nothing"
Assert_Equal m_Logger.HasErrors, True, "T06_Should_Log_Error"
End Sub
' ------------------------------------------------------------------------------
' 测试用例 07: 复杂嵌套
' 输入: A=1 AND (B=1 OR (B=2 AND C=3))
' 期望: 2行
' Row 1: A=1, B=1
' Row 2: A=1, B=2, C=3
' ------------------------------------------------------------------------------
Private Sub Test_07_ComplexNested()
Dim col As Collection
Set col = M03_Logic.ParseRule("A=1 AND (B=1 OR (B=2 AND C=3))", 7)
Assert_Equal col.count, 2, "T07_Count"
Dim count2 As Long, count3 As Long
Dim i As Long
Dim r As Object
For i = 1 To col.count
Set r = col(i)
If r.count = 2 Then count2 = count2 + 1
If r.count = 3 Then count3 = count3 + 1
Next i
Assert_Equal count2, 1, "T07_Row_With_2_Keys"
Assert_Equal count3, 1, "T07_Row_With_3_Keys"
End Sub
' ==============================================================================
' 辅助断言函数
' ==============================================================================
Private Sub Assert_Equal(actual As Variant, expected As Variant, testName As String)
If CStr(actual) = CStr(expected) Then
' Debug.Print " [PASS] " & testName
m_PassCount = m_PassCount + 1
Else
Debug.Print " [FAIL] " & testName & " | Expected: " & expected & ", Actual: " & actual
m_FailCount = m_FailCount + 1
End If
End Sub
Private Sub Assert_NotNull(obj As Object, testName As String)
If Not obj Is Nothing Then
m_PassCount = m_PassCount + 1
Else
Debug.Print " [FAIL] " & testName & " | Object is Nothing"
m_FailCount = m_FailCount + 1
End If
End Sub
' ==============================================================================
' 预处理测试用例
' ==============================================================================
' ------------------------------------------------------------------------------
' 测试用例 PP_01: 测试azxs映射加载
' 验证所有12个azxs值是否正确映射
' ------------------------------------------------------------------------------
Private Sub Test_PP_01_AzxsMappingLoad()
SetupPreProcessorTest
' 测试径向映射
Assert_Equal M05_PreProcessor.GetAzxsMappedValue("A0"), "径向", "PP01_A0_To_径向"
Assert_Equal M05_PreProcessor.GetAzxsMappedValue("AT"), "径向", "PP01_AT_To_径向"
Assert_Equal M05_PreProcessor.GetAzxsMappedValue("AH"), "径向", "PP01_AH_To_径向"
' 测试下轴向映射
Assert_Equal M05_PreProcessor.GetAzxsMappedValue("B0"), "下轴向", "PP01_B0_To_下轴向"
Assert_Equal M05_PreProcessor.GetAzxsMappedValue("BT"), "下轴向", "PP01_BT_To_下轴向"
Assert_Equal M05_PreProcessor.GetAzxsMappedValue("BZ"), "下轴向", "PP01_BZ_To_下轴向"
Assert_Equal M05_PreProcessor.GetAzxsMappedValue("BH"), "下轴向", "PP01_BH_To_下轴向"
' 测试中轴向映射
Assert_Equal M05_PreProcessor.GetAzxsMappedValue("Z0"), "中轴向", "PP01_Z0_To_中轴向"
Assert_Equal M05_PreProcessor.GetAzxsMappedValue("ZT"), "中轴向", "PP01_ZT_To_中轴向"
Assert_Equal M05_PreProcessor.GetAzxsMappedValue("ZZ"), "中轴向", "PP01_ZZ_To_中轴向"
Assert_Equal M05_PreProcessor.GetAzxsMappedValue("ZH"), "中轴向", "PP01_ZH_To_中轴向"
End Sub
' ------------------------------------------------------------------------------
' 测试用例 PP_02: 测试lcfw映射加载
' 验证M01-M11都映射到"低压"
' ------------------------------------------------------------------------------
Private Sub Test_PP_02_LcfwMappingLoad()
SetupPreProcessorTest
Assert_Equal M05_PreProcessor.GetLcfwMappedValue("M01"), "低压", "PP02_M01_To_低压"
Assert_Equal M05_PreProcessor.GetLcfwMappedValue("M02"), "低压", "PP02_M02_To_低压"
Assert_Equal M05_PreProcessor.GetLcfwMappedValue("M03"), "低压", "PP02_M03_To_低压"
Assert_Equal M05_PreProcessor.GetLcfwMappedValue("M11"), "低压", "PP02_M11_To_低压"
End Sub
' ------------------------------------------------------------------------------
' 测试用例 PP_03: 测试azxs值替换
' ------------------------------------------------------------------------------
Private Sub Test_PP_03_AzxsReplacement()
SetupPreProcessorTest
' 单个原子
Dim result1 As String
result1 = M05_PreProcessor.PreprocessCondition("azxs=A0", "接头", 1)
Assert_Equal result1, "azxs=径向", "PP03_Single_Azxs_Replacement"
' 与AND结合
Dim result2 As String
result2 = M05_PreProcessor.PreprocessCondition("gclj=M20 AND azxs=B0", "接头", 2)
Assert_Equal result2, "gclj=M20 AND azxs=下轴向", "PP03_Azxs_With_AND"
' 在OR中
Dim result3 As String
result3 = M05_PreProcessor.PreprocessCondition("azxs=A0 OR azxs=AT", "接头", 3)
Assert_Equal result3, "azxs=径向", "PP03_Azxs_With_OR_Merged"
End Sub
' ------------------------------------------------------------------------------
' 测试用例 PP_04: 测试lcfw值替换
' ------------------------------------------------------------------------------
Private Sub Test_PP_04_LcfwReplacement()
SetupPreProcessorTest
' 单个原子
Dim result1 As String
result1 = M05_PreProcessor.PreprocessCondition("lcfw=M01", "接头", 1)
Assert_Equal result1, "lcfw=低压", "PP04_Single_Lcfw_Replacement"
' 与AND结合
Dim result2 As String
result2 = M05_PreProcessor.PreprocessCondition("gclj=M20 AND lcfw=M02", "接头", 2)
Assert_Equal result2, "gclj=M20 AND lcfw=低压", "PP04_Lcfw_With_AND"
End Sub
' ------------------------------------------------------------------------------
' 测试用例 PP_05: 测试OR条件合并
' ------------------------------------------------------------------------------
Private Sub Test_PP_05_ORMerging()
SetupPreProcessorTest
' 精确重复
Dim result1 As String
result1 = M05_PreProcessor.PreprocessCondition("lcfw=低压 OR lcfw=低压", "接头", 1)
Assert_Equal result1, "lcfw=低压", "PP05_Exact_Duplicate_Merging"
' 多次重复
Dim result2 As String
result2 = M05_PreProcessor.PreprocessCondition("azxs=径向 OR azxs=径向 OR azxs=径向", "接头", 2)
Assert_Equal result2, "azxs=径向", "PP05_Multiple_Duplicate_Merging"
' 混合情况（保留不同的）
Dim result3 As String
result3 = M05_PreProcessor.PreprocessCondition("lcfw=低压 OR lcfw=高压", "接头", 3)
' 注意：高压不会在映射表中，所以保持原值
Dim hasLow As Boolean, hasHigh As Boolean
hasLow = InStr(result3, "lcfw=低压") > 0
hasHigh = InStr(result3, "lcfw=高压") > 0
Assert_Equal hasLow, True, "PP05_Mixed_Has_Low"
Assert_Equal hasHigh, True, "PP05_Mixed_Has_High"
End Sub
' ------------------------------------------------------------------------------
' 测试用例 PP_06: 测试完整集成
' 验证预处理后的结果能被M03_Logic正确解析
' ------------------------------------------------------------------------------
Private Sub Test_PP_06_FullIntegration()
SetupPreProcessorTest
Dim inputCond As String
inputCond = "gclj=M16 AND (azxs=A0 OR azxs=AT) AND (lcfw=M01 OR lcfw=M15)"
' 预处理
Dim preprocessed As String
preprocessed = M05_PreProcessor.PreprocessCondition(inputCond, "接头", 1)
' Debug output
Debug.Print "PP06 Debug:"
Debug.Print " Input: " & inputCond
Debug.Print " Expected: gclj=M16 AND azxs=径向 AND (lcfw=低压 OR lcfw=高压)"
Debug.Print " Actual: " & preprocessed
' 解析预处理后的条件
Dim col As Collection
Set col = M03_Logic.ParseRule(preprocessed, 1)
Assert_NotNull col, "PP06_Result_Not_Null"
Assert_Equal col.count, 2, "PP06_Count_After_Preprocessing"
Dim row As Object
Set row = col(1)
Assert_Equal row("gclj"), "M16", "PP06_gclj_Value"
Assert_Equal row("azxs"), "径向", "PP06_azxs_Mapped_Value"
Assert_Equal row("lcfw"), "低压", "PP06_lcfw_Mapped_Value"
End Sub
' ------------------------------------------------------------------------------
' 测试用例 PP_07: 测试非"接头"/"部件"类别
' 验证其他类别（如"弹性元件"）不受预处理影响
' ------------------------------------------------------------------------------
Private Sub Test_PP_07_NonJointCategory()
SetupPreProcessorTest
Dim inputCond As String
inputCond = "gclj=M20 AND lcfw=M01"
' 使用"弹性元件"类别
Dim result As String
result = M05_PreProcessor.PreprocessCondition(inputCond, "弹性元件", 1)
' 应该保持不变
Assert_Equal result, inputCond, "PP07_NonJoint_Unchanged"
End Sub
' ------------------------------------------------------------------------------
' 测试用例 PP_08: 测试未映射的值
' 验证不在映射表中的值保持原样并记录警告
' ------------------------------------------------------------------------------
Private Sub Test_PP_08_UnmappedValues()
SetupPreProcessorTest
' 重置logger以捕获警告
Set m_Logger = New clsErrorLogger
M05_PreProcessor.InitPreProcessor m_Logger, m_wsMapping
Dim result As String
result = M05_PreProcessor.PreprocessCondition("lcfw=INVALID", "接头", 1)
' 值应该保持不变
Assert_Equal result, "lcfw=INVALID", "PP08_Unmapped_Value_Unchanged"
' 应该记录警告（如果实现了）
' 注意：这个测试可能需要根据实际日志记录行为调整
End Sub
' ------------------------------------------------------------------------------
' 测试用例 PP_09: 测试"部件"类别的azxs映射
' ------------------------------------------------------------------------------
Private Sub Test_PP_09_ComponentCategory_AzxsMapping()
SetupPreProcessorTest
Dim result1 As String
result1 = M05_PreProcessor.PreprocessCondition("azxs=A0 AND gclj=M20", "部件", 1)
Assert_Equal result1, "azxs=径向 AND gclj=M20", "PP09_Component_Azxs_Mapping"
Dim result2 As String
result2 = M05_PreProcessor.PreprocessCondition("gclj=M20 AND azxs=B0", "部件", 2)
Assert_Equal result2, "gclj=M20 AND azxs=下轴向", "PP09_Component_Azxs_With_AND"
End Sub
' ------------------------------------------------------------------------------
' 测试用例 PP_10: 测试"部件"类别的lcfw条件保持不变
' ------------------------------------------------------------------------------
Private Sub Test_PP_10_ComponentCategory_LcfwUnchanged()
SetupPreProcessorTest
Dim result1 As String
result1 = M05_PreProcessor.PreprocessCondition("lcfw=M01 AND gclj=M20", "部件", 1)
Assert_Equal result1, "lcfw=M01 AND gclj=M20", "PP10_Component_Lcfw_Unchanged"
Dim result2 As String
result2 = M05_PreProcessor.PreprocessCondition("gclj=M20 AND lcfw=M01", "部件", 2)
Assert_Equal result2, "gclj=M20 AND lcfw=M01", "PP10_Component_Lcfw_Unchanged_Reverse"
End Sub
' ------------------------------------------------------------------------------
' 测试用例 PP_11: 测试"部件"类别的OR条件合并
' ------------------------------------------------------------------------------
Private Sub Test_PP_11_ComponentCategory_ORMerging()
SetupPreProcessorTest
Dim result1 As String
result1 = M05_PreProcessor.PreprocessCondition("(azxs=A0 OR azxs=AT) AND gclj=M20", "部件", 1)
Assert_Equal result1, "azxs=径向 AND gclj=M20", "PP11_Component_OR_Merging_Azxs"
' 测试精确重复的OR条件合并
Dim result2 As String
result2 = M05_PreProcessor.PreprocessCondition("azxs=径向 OR azxs=径向", "部件", 2)
Assert_Equal result2, "azxs=径向", "PP11_Component_Exact_Duplicate_Merging"
End Sub
' ------------------------------------------------------------------------------
' 测试用例 PP_12: 测试"部件"类别的括号简化
' ------------------------------------------------------------------------------
Private Sub Test_PP_12_ComponentCategory_ParenthesesSimplification()
SetupPreProcessorTest
Dim result1 As String
result1 = M05_PreProcessor.PreprocessCondition("(azxs=A0 OR azxs=AT) AND gclj=M20", "部件", 1)
Assert_Equal result1, "azxs=径向 AND gclj=M20", "PP12_Component_Parentheses_Simplified"
Dim result2 As String
result2 = M05_PreProcessor.PreprocessCondition("gclj=M20 AND (azxs=A0 OR azxs=AT)", "部件", 2)
Assert_Equal result2, "gclj=M20 AND azxs=径向", "PP12_Component_Parentheses_Simplified_Reverse"
End Sub
' ------------------------------------------------------------------------------
' 辅助函数：设置预处理测试环境
' ------------------------------------------------------------------------------
Private Sub SetupPreProcessorTest()
' 查找[对照表]工作表
On Error Resume Next
Set m_wsMapping = ActiveWorkbook.Sheets("对照表")
On Error GoTo 0
If m_wsMapping Is Nothing Then
Debug.Print " [SKIP] 预处理测试 - 未找到[对照表]工作表"
Exit Sub
End If
' 初始化预处理器
Set m_Logger = New clsErrorLogger
M03_Logic.InitLogic m_Logger
M05_PreProcessor.InitPreProcessor m_Logger, m_wsMapping
End Sub