✨ feat(BIP): add weighted parameter error analysis algorithm
Implement intelligent BOM error analysis module that: - Extracts and analyzes failed order matching attempts - Uses feature-weight algorithm (azxs=10000, bkxs=1000, etc.) for accurate parameter conflict detection - Automatically traces unmatched parameters to root cause - Splits multi-error results into separate rows for detailed analysis - Exposes BomExtractor data pool via GetAllItems() for external analysis This solves fuzzy tie problems that caused parameter false positives in previous matching logic. Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
Misaka_Company
@@ -479,4 +479,12 @@ Public Function GetErrorSummary() As String
|
||||
Next msg
|
||||
GetErrorSummary = result
|
||||
End If
|
||||
End Function
|
||||
'=====================================================================
|
||||
' 方法: GetAllItems
|
||||
' 功能: 获取所有加载的BOM物料 (暴露数据池供异常分析溯源算法使用)
|
||||
' 返回: Collection
|
||||
'=====================================================================
|
||||
Public Function GetAllItems() As Collection
|
||||
Set GetAllItems = pAllItems
|
||||
End Function
|
||||
559
VBA/Modules/ErrorAnalysisModule.bas
Normal file
559
VBA/Modules/ErrorAnalysisModule.bas
Normal file
@@ -0,0 +1,559 @@
|
||||
'=====================================================================
|
||||
' 模块名: ErrorAnalysisModule
|
||||
' 功能: BOM匹配异常分析模块，仅提取报错订单，拆分多行，并自动回溯"未匹配参数"
|
||||
' 特性: 采用"特征权重算法"解决模糊平局(Tie)导致的参数误报问题
|
||||
'=====================================================================
|
||||
|
||||
Option Explicit
|
||||
|
||||
' 提取条件配置
|
||||
Private Const CONDITION_CONFIG = "azxs,安装形式|bkxs,表壳形式|gclj,过程连接|jycz,接液材质|lcfw,量程范围|fjgn,附加功能"
|
||||
|
||||
'=====================================================================
|
||||
' 过程: GenerateErrorAnalysisReport
|
||||
' 功能: 批量处理产品型号，输出BOM匹配异常报表
|
||||
'=====================================================================
|
||||
Public Sub GenerateErrorAnalysisReport()
|
||||
On Error GoTo ErrorHandler
|
||||
|
||||
Dim startTime As Double
|
||||
startTime = Timer
|
||||
|
||||
Application.ScreenUpdating = False
|
||||
Application.Calculation = xlCalculationManual
|
||||
|
||||
' 获取工作表
|
||||
Dim orderSheet As Worksheet
|
||||
Dim bomSheet As Worksheet
|
||||
Dim outputSheet As Worksheet
|
||||
|
||||
Set orderSheet = GetOrderSheet()
|
||||
If orderSheet Is Nothing Then
|
||||
RestoreAppStatus
|
||||
MsgBox "未找到[产品订单]工作表!", vbCritical
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Set bomSheet = GetBomSheet()
|
||||
If bomSheet Is Nothing Then
|
||||
RestoreAppStatus
|
||||
MsgBox "未找到[平台配置清单]工作表!", vbCritical
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' 初始化BOM提取器
|
||||
Dim BomExtractor As BomExtractor
|
||||
Set BomExtractor = New BomExtractor
|
||||
BomExtractor.SetWorksheet bomSheet
|
||||
|
||||
If Not BomExtractor.LoadBomData Then
|
||||
RestoreAppStatus
|
||||
MsgBox "加载BOM数据失败:" & BomExtractor.GetErrorSummary, vbCritical
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' 获取或创建输出表
|
||||
Set outputSheet = CreateErrorOutputSheet()
|
||||
WriteOutputHeader outputSheet
|
||||
|
||||
' 获取筛选后的订单数据
|
||||
Dim lastRow As Long
|
||||
lastRow = orderSheet.Cells(orderSheet.Rows.count, 3).End(xlUp).row
|
||||
If lastRow < 2 Then
|
||||
RestoreAppStatus
|
||||
MsgBox "[产品订单]工作表中没有数据!", vbExclamation
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Dim sourceDataArr As Variant
|
||||
sourceDataArr = orderSheet.Range("A2:F" & lastRow).value
|
||||
|
||||
Dim visibleRange As Range
|
||||
On Error Resume Next
|
||||
Set visibleRange = orderSheet.Range("A2:A" & lastRow).SpecialCells(xlCellTypeVisible)
|
||||
On Error GoTo ErrorHandler
|
||||
|
||||
If visibleRange Is Nothing Then
|
||||
RestoreAppStatus
|
||||
MsgBox "当前筛选状态下没有可见的数据。", vbInformation
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' 初始化正则表达式引擎 (只初始化一次，提速)
|
||||
Dim regEx As Object
|
||||
Set regEx = CreateObject("VBScript.RegExp")
|
||||
regEx.Global = True
|
||||
regEx.IgnoreCase = True
|
||||
' 匹配如 azxs=A0, fjgn!=N1 这样的条件结构
|
||||
regEx.Pattern = "(azxs|bkxs|gclj|jycz|lcfw|fjgn)\s*(!=|=)\s*([A-Za-z0-9_]+)"
|
||||
|
||||
Dim outputData As Collection
|
||||
Set outputData = New Collection
|
||||
|
||||
Dim cell As Range
|
||||
Dim arrIndex As Long
|
||||
Dim totalProcessed As Long
|
||||
Dim errorOrdersCount As Long
|
||||
Dim errorRowsCount As Long
|
||||
|
||||
totalProcessed = 0
|
||||
errorOrdersCount = 0
|
||||
errorRowsCount = 0
|
||||
|
||||
' 遍历可见订单
|
||||
For Each cell In visibleRange
|
||||
arrIndex = cell.row - 1
|
||||
|
||||
Dim totalQueueNum As String
|
||||
Dim orderNumber As String
|
||||
Dim modelString As String
|
||||
Dim componentPriority As String
|
||||
|
||||
totalQueueNum = Trim(sourceDataArr(arrIndex, 1))
|
||||
orderNumber = Trim(sourceDataArr(arrIndex, 2))
|
||||
modelString = Trim(sourceDataArr(arrIndex, 3))
|
||||
componentPriority = Trim(sourceDataArr(arrIndex, 6))
|
||||
|
||||
If modelString <> "" Then
|
||||
totalProcessed = totalProcessed + 1
|
||||
|
||||
' 解析并匹配BOM
|
||||
Dim parser As ProductModelParser
|
||||
Set parser = New ProductModelParser
|
||||
|
||||
Dim hasError As Boolean
|
||||
hasError = False
|
||||
Dim errors As String
|
||||
errors = ""
|
||||
|
||||
If Not parser.Parse(modelString) Then
|
||||
hasError = True
|
||||
errors = "型号解析失败: " & parser.ErrorMessage
|
||||
Else
|
||||
' 提取逻辑
|
||||
BomExtractor.ClearExcludeCategories
|
||||
If UCase(componentPriority) = "否" Or componentPriority = "0" Or componentPriority = "FALSE" Then
|
||||
Dim excludeCats As New Collection
|
||||
excludeCats.Add "部件"
|
||||
BomExtractor.SetExcludeCategories excludeCats
|
||||
End If
|
||||
|
||||
Dim matchedItems As Collection
|
||||
Set matchedItems = BomExtractor.ExtractBom(parser.conditions)
|
||||
|
||||
errors = BomExtractor.GetErrorSummary()
|
||||
If errors <> "" Or matchedItems.count = 0 Then
|
||||
hasError = True
|
||||
If errors = "" And matchedItems.count = 0 Then
|
||||
errors = "完全未匹配到物料"
|
||||
End If
|
||||
End If
|
||||
|
||||
' 深度检查BOM行自身的报错（如"匹配到多条"）
|
||||
Dim item As BomItem
|
||||
For Each item In matchedItems
|
||||
If item.MatchError <> "" Then
|
||||
hasError = True
|
||||
errors = errors & item.category & ":" & item.MatchError & ";"
|
||||
End If
|
||||
Next item
|
||||
End If
|
||||
|
||||
' 如果存在错误，拆分为多行并寻找未匹配参数
|
||||
If hasError Then
|
||||
errorOrdersCount = errorOrdersCount + 1
|
||||
|
||||
Dim errArray() As String
|
||||
errArray = Split(errors, ";")
|
||||
Dim i As Long
|
||||
|
||||
For i = LBound(errArray) To UBound(errArray)
|
||||
Dim singleError As String
|
||||
singleError = Trim(errArray(i))
|
||||
|
||||
If singleError <> "" Then
|
||||
Dim unmatchedValues As String
|
||||
unmatchedValues = "无法精准定位"
|
||||
|
||||
' 如果是型号解析失败，跳过溯源
|
||||
If InStr(singleError, "型号解析失败") = 0 And InStr(singleError, "完全未匹配到物料") = 0 Then
|
||||
Dim targetCategory As String
|
||||
targetCategory = ExtractCategoryName(singleError)
|
||||
|
||||
If targetCategory <> "" Then
|
||||
' 核心：调用带权重的重合度算法定位冲突参数(通过 | 分隔)
|
||||
unmatchedValues = FindUnmatchedParameter(targetCategory, parser.conditions, BomExtractor.GetAllItems(), regEx)
|
||||
End If
|
||||
End If
|
||||
|
||||
' ---> 拆分未匹配参数，避免糅合在一起
|
||||
Dim unmatchArr() As String
|
||||
unmatchArr = Split(unmatchedValues, "|")
|
||||
|
||||
Dim j As Long
|
||||
For j = LBound(unmatchArr) To UBound(unmatchArr)
|
||||
Dim singleUnmatch As String
|
||||
singleUnmatch = Trim(unmatchArr(j))
|
||||
If singleUnmatch <> "" Then
|
||||
outputData.Add CreateErrorRowArray(totalQueueNum, orderNumber, modelString, parser.conditions, singleUnmatch, singleError)
|
||||
errorRowsCount = errorRowsCount + 1
|
||||
End If
|
||||
Next j
|
||||
End If
|
||||
Next i
|
||||
End If
|
||||
End If
|
||||
Next cell
|
||||
|
||||
' 批量写入数据
|
||||
If outputData.count > 0 Then
|
||||
WriteBatchData outputSheet, outputData
|
||||
Else
|
||||
MsgBox "太棒了！所选订单均完美匹配BOM，未发现任何异常。", vbInformation
|
||||
End If
|
||||
|
||||
' 格式化表格
|
||||
FormatOutputSheet outputSheet
|
||||
|
||||
RestoreAppStatus
|
||||
Dim elapsedTime As Double
|
||||
elapsedTime = Timer - startTime
|
||||
|
||||
MsgBox "异常分析完成!" & vbCrLf & _
|
||||
"共检查订单: " & totalProcessed & vbCrLf & _
|
||||
"发现异常订单: " & errorOrdersCount & vbCrLf & _
|
||||
"生成异常明细: " & errorRowsCount & " 行" & vbCrLf & _
|
||||
"用时: " & Format(elapsedTime, "0.00") & "秒", vbInformation
|
||||
|
||||
outputSheet.Activate
|
||||
Exit Sub
|
||||
|
||||
ErrorHandler:
|
||||
RestoreAppStatus
|
||||
MsgBox "异常分析发生错误: " & Err.Description, vbCritical
|
||||
End Sub
|
||||
|
||||
'=====================================================================
|
||||
' 核心算法: FindUnmatchedParameter (带权重的最大特征重合度算法)
|
||||
' 功能: 分析BOM库，找出与当前订单特征最相似的物料，并提取冲突(未匹配)的参数值
|
||||
'=====================================================================
|
||||
Private Function FindUnmatchedParameter(category As String, productConds As Object, allBomItems As Collection, regEx As Object) As String
|
||||
' 使用 Long 类型，因为加入权重后得分会超过 Integer 上限
|
||||
Dim maxScore As Long
|
||||
maxScore = -1
|
||||
Dim bestConflictKeys As String
|
||||
bestConflictKeys = ""
|
||||
|
||||
Dim item As BomItem
|
||||
|
||||
' 遍历BOM库中同类别的所有物料
|
||||
For Each item In allBomItems
|
||||
If item.category = category And Trim(item.SelectCondition) <> "" Then
|
||||
|
||||
Dim allowed As Object
|
||||
Set allowed = CreateObject("Scripting.Dictionary")
|
||||
Dim forbidden As Object
|
||||
Set forbidden = CreateObject("Scripting.Dictionary")
|
||||
|
||||
' 使用正则提取该物料的所有约束条件 (如 azxs=A0)
|
||||
Dim matches As Object
|
||||
Set matches = regEx.Execute(item.SelectCondition)
|
||||
|
||||
Dim match As Object
|
||||
For Each match In matches
|
||||
Dim k As String, op As String, v As String
|
||||
k = match.SubMatches(0)
|
||||
op = Trim(match.SubMatches(1))
|
||||
v = Trim(match.SubMatches(2))
|
||||
|
||||
If op = "=" Then
|
||||
If Not allowed.Exists(k) Then allowed(k) = "|"
|
||||
allowed(k) = allowed(k) & v & "|"
|
||||
ElseIf op = "!=" Or op = "<>" Then
|
||||
If Not forbidden.Exists(k) Then forbidden(k) = "|"
|
||||
forbidden(k) = forbidden(k) & v & "|"
|
||||
End If
|
||||
Next match
|
||||
|
||||
' 合并出现过的所有参数键
|
||||
Dim allRuleKeys As Object
|
||||
Set allRuleKeys = CreateObject("Scripting.Dictionary")
|
||||
|
||||
Dim vKey As Variant
|
||||
For Each vKey In allowed.Keys: allRuleKeys(vKey) = True: Next vKey
|
||||
For Each vKey In forbidden.Keys: allRuleKeys(vKey) = True: Next vKey
|
||||
|
||||
Dim currentScore As Long
|
||||
currentScore = 0
|
||||
Dim currentConflicts As String
|
||||
currentConflicts = ""
|
||||
|
||||
' 计算该物料与实际订单参数的重合度得分
|
||||
Dim keyVar As Variant
|
||||
For Each keyVar In allRuleKeys.Keys
|
||||
Dim keyStr As String
|
||||
keyStr = CStr(keyVar)
|
||||
|
||||
Dim prodVal As String
|
||||
If productConds.Exists(keyStr) Then prodVal = productConds(keyStr) Else prodVal = ""
|
||||
|
||||
Dim isMatch As Boolean
|
||||
isMatch = False
|
||||
|
||||
If allowed.Exists(keyStr) Then
|
||||
' 如果实际值包含在允许值中，则得分
|
||||
If InStr(allowed(keyStr), "|" & prodVal & "|") > 0 Then
|
||||
isMatch = True
|
||||
End If
|
||||
ElseIf forbidden.Exists(keyStr) Then
|
||||
' 如果没有允许值限制，只有禁止值限制，且实际值不在禁止值中，则得分
|
||||
If InStr(forbidden(keyStr), "|" & prodVal & "|") = 0 Then
|
||||
isMatch = True
|
||||
End If
|
||||
End If
|
||||
|
||||
If isMatch Then
|
||||
' 【核心修改】引入特征权重，让系统具备业务直觉
|
||||
currentScore = currentScore + GetFeatureWeight(keyStr)
|
||||
Else
|
||||
currentConflicts = currentConflicts & keyStr & ","
|
||||
End If
|
||||
Next keyVar
|
||||
|
||||
' 更新最高得分记录
|
||||
If currentScore > maxScore Then
|
||||
maxScore = currentScore
|
||||
bestConflictKeys = currentConflicts
|
||||
ElseIf currentScore = maxScore And currentScore > 0 Then
|
||||
' 如果权重得分依然相同，合并所有可能的冲突原因
|
||||
Dim keysArray() As String
|
||||
keysArray = Split(currentConflicts, ",")
|
||||
Dim cKey As Variant
|
||||
For Each cKey In keysArray
|
||||
If Trim(cKey) <> "" And InStr(bestConflictKeys, cKey & ",") = 0 Then
|
||||
bestConflictKeys = bestConflictKeys & cKey & ","
|
||||
End If
|
||||
Next cKey
|
||||
End If
|
||||
|
||||
End If
|
||||
Next item
|
||||
|
||||
' 将最高分的冲突Key翻译为实际的参数值
|
||||
If bestConflictKeys <> "" Then
|
||||
Dim resultStr As String
|
||||
resultStr = ""
|
||||
Dim finalKeys() As String
|
||||
finalKeys = Split(bestConflictKeys, ",")
|
||||
|
||||
Dim fKey As Variant
|
||||
For Each fKey In finalKeys
|
||||
If Trim(fKey) <> "" Then
|
||||
Dim actVal As String
|
||||
If productConds.Exists(fKey) Then actVal = productConds(fKey) Else actVal = "无值"
|
||||
|
||||
' 使用 | 作为分隔符进行拼接去重
|
||||
If resultStr = "" Then
|
||||
resultStr = actVal
|
||||
Else
|
||||
If InStr("|" & resultStr & "|", "|" & actVal & "|") = 0 Then
|
||||
resultStr = resultStr & "|" & actVal
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
Next fKey
|
||||
|
||||
If resultStr <> "" Then
|
||||
FindUnmatchedParameter = resultStr
|
||||
Else
|
||||
FindUnmatchedParameter = "无法精准定位"
|
||||
End If
|
||||
Else
|
||||
FindUnmatchedParameter = "无法精准定位"
|
||||
End If
|
||||
End Function
|
||||
|
||||
'=====================================================================
|
||||
' 辅助函数: GetFeatureWeight
|
||||
' 功能: 获取字段的匹配权重，严格保证高优先级特征的决定性
|
||||
'=====================================================================
|
||||
Private Function GetFeatureWeight(keyStr As String) As Long
|
||||
Select Case LCase(Trim(keyStr))
|
||||
Case "azxs"
|
||||
GetFeatureWeight = 10000 ' 安装形式 - 决定物理结构，最重要
|
||||
Case "bkxs"
|
||||
GetFeatureWeight = 1000 ' 表壳形式
|
||||
Case "gclj"
|
||||
GetFeatureWeight = 100 ' 过程连接
|
||||
Case "jycz"
|
||||
GetFeatureWeight = 50 ' 接液材质
|
||||
Case "lcfw"
|
||||
GetFeatureWeight = 10 ' 量程范围
|
||||
Case "fjgn"
|
||||
GetFeatureWeight = 1 ' 附加功能
|
||||
Case Else
|
||||
GetFeatureWeight = 0
|
||||
End Select
|
||||
End Function
|
||||
|
||||
'=====================================================================
|
||||
' 辅助函数: ExtractCategoryName
|
||||
' 功能: 从报错文本如 "必需类别[部件]未匹配" 中提取出 "部件"
|
||||
'=====================================================================
|
||||
Private Function ExtractCategoryName(errorMsg As String) As String
|
||||
Dim startPos As Long
|
||||
Dim endPos As Long
|
||||
startPos = InStr(errorMsg, "[")
|
||||
endPos = InStr(errorMsg, "]")
|
||||
|
||||
If startPos > 0 And endPos > startPos Then
|
||||
ExtractCategoryName = Mid(errorMsg, startPos + 1, endPos - startPos - 1)
|
||||
Else
|
||||
ExtractCategoryName = ""
|
||||
End If
|
||||
End Function
|
||||
|
||||
'=====================================================================
|
||||
' 过程: WriteOutputHeader
|
||||
'=====================================================================
|
||||
Private Sub WriteOutputHeader(ws As Worksheet)
|
||||
Dim col As Long
|
||||
col = 1
|
||||
|
||||
ws.Cells(1, col).value = "总排号": col = col + 1
|
||||
ws.Cells(1, col).value = "生产订单号": col = col + 1
|
||||
ws.Cells(1, col).value = "产品型号": col = col + 1
|
||||
|
||||
Dim configs() As String
|
||||
configs = Split(CONDITION_CONFIG, "|")
|
||||
Dim i As Long
|
||||
For i = LBound(configs) To UBound(configs)
|
||||
ws.Cells(1, col).value = Trim(Split(configs(i), ",")(1))
|
||||
col = col + 1
|
||||
Next i
|
||||
|
||||
ws.Cells(1, col).value = "未匹配参数": col = col + 1
|
||||
ws.Cells(1, col).value = "提取备注": col = col + 1
|
||||
End Sub
|
||||
|
||||
'=====================================================================
|
||||
' 函数: CreateErrorRowArray
|
||||
' 功能: 构建输出的一行数据
|
||||
'=====================================================================
|
||||
Private Function CreateErrorRowArray(totalQueueNum As String, orderNumber As String, _
|
||||
modelStr As String, conditions As Object, _
|
||||
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
|
||||
|
||||
ReDim rowData(1 To totalCols) As Variant
|
||||
Dim col As Long
|
||||
col = 1
|
||||
|
||||
rowData(col) = totalQueueNum: col = col + 1
|
||||
rowData(col) = orderNumber: col = col + 1
|
||||
rowData(col) = modelStr: col = col + 1
|
||||
|
||||
Dim i As Long
|
||||
For i = LBound(configs) To UBound(configs)
|
||||
Dim key As String
|
||||
key = Trim(Split(configs(i), ",")(0))
|
||||
If conditions.Exists(key) Then
|
||||
rowData(col) = conditions(key)
|
||||
Else
|
||||
rowData(col) = ""
|
||||
End If
|
||||
col = col + 1
|
||||
Next i
|
||||
|
||||
rowData(col) = unmatchedValue: col = col + 1
|
||||
rowData(col) = errorNote: col = col + 1
|
||||
|
||||
CreateErrorRowArray = rowData
|
||||
End Function
|
||||
|
||||
'=====================================================================
|
||||
' 过程: WriteBatchData
|
||||
'=====================================================================
|
||||
Private Sub WriteBatchData(ws As Worksheet, outputData As Collection)
|
||||
Dim firstRow As Variant
|
||||
firstRow = outputData(1)
|
||||
|
||||
Dim rowCount As Long
|
||||
Dim colCount As Long
|
||||
rowCount = outputData.count
|
||||
colCount = UBound(firstRow) - LBound(firstRow) + 1
|
||||
|
||||
Dim resultData() As Variant
|
||||
ReDim resultData(1 To rowCount, 1 To colCount)
|
||||
|
||||
Dim i As Long, j As Long
|
||||
Dim rowArray As Variant
|
||||
For i = 1 To rowCount
|
||||
rowArray = outputData(i)
|
||||
For j = 1 To colCount
|
||||
resultData(i, j) = rowArray(j)
|
||||
Next j
|
||||
Next i
|
||||
|
||||
ws.Range("A2").Resize(rowCount, colCount).value = resultData
|
||||
End Sub
|
||||
|
||||
'=====================================================================
|
||||
' 辅助过程
|
||||
'=====================================================================
|
||||
Private Function GetOrderSheet() As Worksheet
|
||||
On Error Resume Next
|
||||
Set GetOrderSheet = ThisWorkbook.Worksheets("产品订单")
|
||||
If GetOrderSheet Is Nothing Then Set GetOrderSheet = ActiveSheet
|
||||
On Error GoTo 0
|
||||
End Function
|
||||
|
||||
Private Function GetBomSheet() As Worksheet
|
||||
On Error Resume Next
|
||||
Set GetBomSheet = ThisWorkbook.Worksheets("平台配置清单")
|
||||
On Error GoTo 0
|
||||
End Function
|
||||
|
||||
Private Function CreateErrorOutputSheet() As Worksheet
|
||||
Dim wsName As String
|
||||
wsName = "BOM匹配异常报表"
|
||||
On Error Resume Next
|
||||
Set CreateErrorOutputSheet = ThisWorkbook.Worksheets(wsName)
|
||||
On Error GoTo 0
|
||||
|
||||
If CreateErrorOutputSheet Is Nothing Then
|
||||
Set CreateErrorOutputSheet = ThisWorkbook.Worksheets.Add
|
||||
CreateErrorOutputSheet.Name = wsName
|
||||
Else
|
||||
CreateErrorOutputSheet.Cells.Clear
|
||||
End If
|
||||
End Function
|
||||
|
||||
Private Sub FormatOutputSheet(ws As Worksheet)
|
||||
On Error Resume Next
|
||||
With ws.Rows(1)
|
||||
.Font.Bold = True
|
||||
.Interior.Color = RGB(244, 176, 132) ' 橙色背景，突出异常属性
|
||||
.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
|
||||
End If
|
||||
|
||||
ws.Columns.AutoFit
|
||||
On Error GoTo 0
|
||||
End Sub
|
||||
|
||||
Private Sub RestoreAppStatus()
|
||||
Application.Calculation = xlCalculationAutomatic
|
||||
Application.ScreenUpdating = True
|
||||
End Sub
|
||||
Reference in New Issue
Block a user