093a2d0a3b
All checks were successful
NTFY Notification / notify (push) Successful in 11s
Add complete BOM auto-extraction system with the following modules: - M06_ModelParser: Parse product model strings to extract parameters (azxs, bkxs, gclj, jycz, lcfw, fjgn) - Extracts header part from full model (ignores dial/attachment parts) - Splits process connection and material code (G123 -> G12, 3) - Supports multiple additional features with comma/dot separators - M07_BOMMatcher: Match materials in BOM library - Exact match, wildcard (empty cell), negative match (!=) - Special fjgn contains matching logic - Array-based performance optimization for bulk operations - M08_ComponentProcessor: Handle component material special logic - Component inventory check (interface reserved) - Sub-component extraction (joint + elastic element) - Combination validation rules (1 component OR 1 joint + 1 element) - M09_BOMExtractor: Main extraction orchestrator - Reads input models from worksheet - Processes each model and matches all material types - Outputs to "BOM提取结果" worksheet - Error reporting and non-blocking design - M06B_TestRunner: Comprehensive unit tests - 8 test cases for model parsing - 5 test cases for BOM matching - 5 test cases for component processing - M04_Config: Add BOM extraction constants - BOM library filename and configuration - Input/output column definitions - Output column enumeration - M01_Main: Add RunBOMExtraction entry point Co-Authored-By: Claude Sonnet 4.5 <noreply@anthropic.com>
677 lines
22 KiB
QBasic
677 lines
22 KiB
QBasic
' ==============================================================================
|
||
' 模块: M01_Main
|
||
' 职责: 程序入口，调度器，UI交互(进度条)
|
||
' ==============================================================================
|
||
Option Explicit
|
||
|
||
' ------------------------------------------------------------------------------
|
||
' 入口1: 运行BOM转换系统（原功能）
|
||
' 功能: 从"平台配置清单"读取数据，解析条件规则，生成分类BOM
|
||
' ------------------------------------------------------------------------------
|
||
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
|
||
|
||
' ------------------------------------------------------------------------------
|
||
' 入口2: 运行BOM自动提取系统（新功能）
|
||
' 功能: 从产品型号中提取参数，匹配BOM库，输出标准BOM清单
|
||
'
|
||
' 使用方法:
|
||
' 1. 在当前工作簿中准备"产品型号"列的工作表
|
||
' 2. 确保BOM库.xlsx在同一目录下
|
||
' 3. 运行此函数
|
||
'
|
||
' 输出: 在"BOM提取结果"工作表中显示提取结果
|
||
' ------------------------------------------------------------------------------
|
||
Public Sub RunBOMExtraction()
|
||
Dim result As String
|
||
result = M09_BOMExtractor.RunBOMExtraction()
|
||
MsgBox result, vbInformation, "BOM提取"
|
||
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 |