feat: add preprocessing report generator for joint category
Some checks failed
NTFY Notification / notify (push) Failing after 7s
Some checks failed
NTFY Notification / notify (push) Failing after 7s
Add GeneratePreprocessingReport() function to create a detailed comparison report showing condition transformations for "接头" category. Features include: - Statistics summary (total rows, success count, OR merges, etc.) - Detailed comparison table (11 columns: row, code, name, qty, category, original condition, converted condition, mapping details, description, status, errors) - Color-coded status (green=success, yellow=warning, gray=no change, blue=empty) - Mapping details column showing field transformations (e.g., azxs=A0 → azxs=径向) - Integration with main workflow via optional prompt Co-Authored-By: Claude Sonnet 4.5 <noreply@anthropic.com>
This commit is contained in:
@@ -114,6 +114,13 @@ Public Sub RunBOMConversion()
|
|||||||
MsgBox "转换完成,但发现部分数据存在逻辑冲突,已生成错误报告。", vbExclamation
|
MsgBox "转换完成,但发现部分数据存在逻辑冲突,已生成错误报告。", vbExclamation
|
||||||
End If
|
End If
|
||||||
|
|
||||||
|
' 7. 询问是否生成预处理报表(可选)
|
||||||
|
If MsgBox("是否生成预处理条件转换对比报表?" & vbCrLf & _
|
||||||
|
"(仅展示'接头'类别的条件转换结果)", _
|
||||||
|
vbQuestion + vbYesNo, "预处理报表") = vbYes Then
|
||||||
|
Call GeneratePreprocessingReport
|
||||||
|
End If
|
||||||
|
|
||||||
ExitHandler:
|
ExitHandler:
|
||||||
' 清理状态
|
' 清理状态
|
||||||
Application.StatusBar = False
|
Application.StatusBar = False
|
||||||
@@ -124,4 +131,533 @@ ExitHandler:
|
|||||||
MainErrorHandler:
|
MainErrorHandler:
|
||||||
MsgBox "发生运行时错误: " & Err.Description, vbCritical
|
MsgBox "发生运行时错误: " & Err.Description, vbCritical
|
||||||
Resume ExitHandler
|
Resume ExitHandler
|
||||||
End Sub
|
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
|
||||||
Reference in New Issue
Block a user