feat: add preprocessing report generator for joint category

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>
2026-02-10 13:56:00 +08:00
parent 613d4436de
commit 7b2bd25d9a
1 changed files with 537 additions and 1 deletions
--- a/VBA/Modules/M01_Main.bas
+++ b/VBA/Modules/M01_Main.bas
@@ -114,6 +114,13 @@ Public Sub RunBOMConversion()
        MsgBox "转换完成，但发现部分数据存在逻辑冲突，已生成错误报告。", vbExclamation
    End If

+    ' 7. 询问是否生成预处理报表（可选）
+    If MsgBox("是否生成预处理条件转换对比报表？" & vbCrLf & _
+              "(仅展示'接头'类别的条件转换结果)", _
+              vbQuestion + vbYesNo, "预处理报表") = vbYes Then
+        Call GeneratePreprocessingReport
+    End If
+
 ExitHandler:
    ' 清理状态
    Application.StatusBar = False
@@ -124,4 +131,533 @@ ExitHandler:
 MainErrorHandler:
    MsgBox "发生运行时错误: " & Err.Description, vbCritical
    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