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:
Misaka_Company
@@ -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
|
||||
@@ -125,3 +132,532 @@ 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
|
||||
Reference in New Issue
Block a user