diff --git a/VBA/Modules/ErrorAnalysisModule.bas b/VBA/Modules/ErrorAnalysisModule.bas index 516d5e4..14acd12 100644 --- a/VBA/Modules/ErrorAnalysisModule.bas +++ b/VBA/Modules/ErrorAnalysisModule.bas @@ -173,7 +173,7 @@ Public Sub GenerateErrorAnalysisReport() If singleError <> "" Then Dim unmatchedValues As String - unmatchedValues = "无法精准定位" + unmatchedValues = "无法精准定位:无法精准定位" ' 如果是型号解析失败,跳过溯源 If InStr(singleError, "型号解析失败") = 0 And InStr(singleError, "完全未匹配到物料") = 0 Then @@ -181,7 +181,7 @@ Public Sub GenerateErrorAnalysisReport() targetCategory = ExtractCategoryName(singleError) If targetCategory <> "" Then - ' 核心:调用带权重的重合度算法定位冲突参数(通过 | 分隔) + ' 核心:调用带权重的重合度算法定位冲突参数(通过 | 分隔,内部用 : 分隔键值) unmatchedValues = FindUnmatchedParameter(targetCategory, parser.conditions, BomExtractor.GetAllItems(), regEx) End If End If @@ -195,7 +195,21 @@ Public Sub GenerateErrorAnalysisReport() Dim singleUnmatch As String singleUnmatch = Trim(unmatchArr(j)) If singleUnmatch <> "" Then - outputData.Add CreateErrorRowArray(totalQueueNum, orderNumber, modelString, parser.conditions, singleUnmatch, singleError) + Dim uParam As String + Dim uValue As String + Dim colonPos As Long + colonPos = InStr(singleUnmatch, ":") + + ' 拆分键和值 + If colonPos > 0 Then + uParam = Left(singleUnmatch, colonPos - 1) + uValue = Mid(singleUnmatch, colonPos + 1) + Else + uParam = singleUnmatch + uValue = singleUnmatch + End If + + outputData.Add CreateErrorRowArray(totalQueueNum, orderNumber, modelString, parser.conditions, uParam, uValue, singleError) errorRowsCount = errorRowsCount + 1 End If Next j @@ -352,12 +366,15 @@ Private Function FindUnmatchedParameter(category As String, productConds As Obje Dim actVal As String If productConds.Exists(fKey) Then actVal = productConds(fKey) Else actVal = "无值" - ' 使用 | 作为分隔符进行拼接去重 + ' 使用 | 作为条目分隔符,使用 : 分隔键和值 + Dim pairStr As String + pairStr = fKey & ":" & actVal + If resultStr = "" Then - resultStr = actVal + resultStr = pairStr Else - If InStr("|" & resultStr & "|", "|" & actVal & "|") = 0 Then - resultStr = resultStr & "|" & actVal + If InStr("|" & resultStr & "|", "|" & pairStr & "|") = 0 Then + resultStr = resultStr & "|" & pairStr End If End If End If @@ -366,10 +383,10 @@ Private Function FindUnmatchedParameter(category As String, productConds As Obje If resultStr <> "" Then FindUnmatchedParameter = resultStr Else - FindUnmatchedParameter = "无法精准定位" + FindUnmatchedParameter = "无法精准定位:无法精准定位" End If Else - FindUnmatchedParameter = "无法精准定位" + FindUnmatchedParameter = "无法精准定位:无法精准定位" End If End Function @@ -433,6 +450,7 @@ Private Sub WriteOutputHeader(ws As Worksheet) Next i ws.Cells(1, col).value = "未匹配参数": col = col + 1 + ws.Cells(1, col).value = "未匹配参数值": col = col + 1 ws.Cells(1, col).value = "提取备注": col = col + 1 End Sub @@ -442,12 +460,12 @@ End Sub '===================================================================== Private Function CreateErrorRowArray(totalQueueNum As String, orderNumber As String, _ modelStr As String, conditions As Object, _ - unmatchedValue As String, errorNote As String) As Variant() + unmatchedParam As String, unmatchedValue As String, errorNote As String) As Variant() Dim configs() As String configs = Split(CONDITION_CONFIG, "|") Dim totalCols As Long - totalCols = 3 + UBound(configs) - LBound(configs) + 1 + 2 + totalCols = 3 + UBound(configs) - LBound(configs) + 1 + 3 ReDim rowData(1 To totalCols) As Variant Dim col As Long @@ -469,6 +487,7 @@ Private Function CreateErrorRowArray(totalQueueNum As String, orderNumber As Str col = col + 1 Next i + rowData(col) = unmatchedParam: col = col + 1 rowData(col) = unmatchedValue: col = col + 1 rowData(col) = errorNote: col = col + 1 @@ -541,12 +560,17 @@ Private Sub FormatOutputSheet(ws As Worksheet) .HorizontalAlignment = xlCenter End With - ' 将"未匹配参数"列(倒数第2列)加粗显示,颜色标红 - Dim unmatchCol As Long - unmatchCol = ws.Cells(1, ws.Columns.count).End(xlToLeft).Column - 1 - If unmatchCol > 0 Then - ws.Columns(unmatchCol).Font.Color = RGB(255, 0, 0) - ws.Columns(unmatchCol).Font.Bold = True + ' 将"未匹配参数"列和"未匹配参数值"列加粗显示,颜色标红 + Dim unmatchValCol As Long + unmatchValCol = ws.Cells(1, ws.Columns.count).End(xlToLeft).Column - 1 + Dim unmatchParamCol As Long + unmatchParamCol = unmatchValCol - 1 + + If unmatchParamCol > 0 Then + ws.Columns(unmatchParamCol).Font.Color = RGB(255, 0, 0) + ws.Columns(unmatchParamCol).Font.Bold = True + ws.Columns(unmatchValCol).Font.Color = RGB(255, 0, 0) + ws.Columns(unmatchValCol).Font.Bold = True End If ws.Columns.AutoFit