ARTICLE · 1349430
Excel-vba一键整行高亮异常数据|产能不达标、不良率超标直接标红,不用反复设置条件格式
Excel-vba一键整行高亮异常数据|产能不达标、不良率超标直接标红,不用反复设置条件格式工厂生产台账一大堆，每天要找不良超标的、产量没达成的记录。自带条件格式做多了容易卡，改阈值还要重新设置。这段数组VBA，直接匹配规则，整行标记，改标准一键重刷，适合产量表、品质报表。 功能说明 1. 支持自定义监控列、阈值、判断方向（大于/小于） 2. 匹配上规则，整行填充颜色高亮，一眼锁定异常 3. 运行时先清空之前标记的底色，不会新旧颜色叠在一起 4. 数组读取数据，上万行跑起来流畅不卡顿 5. 只处理数据区域，表头不动，空行自动跳过 6. Excel、WPS宏版本都兼容 使用步骤 Alt+F11打开VBA编辑器 → 插入【模块】，粘贴代码 文件另存为 .xlsm 启用宏格式，打开台账运行【MarkAbnormalRow】 vba Option Explicit Sub MarkAbnormalRow() Dim arr As Variant Dim lastRow As Long, lastCol As Long Dim i As Long, markCol As Long Dim threshold As Double Dim sht As Worksheet '==== 这里按需改参数 ==== Set sht = ActiveSheet markCol = 6 '判断用的列，F列=6，不良率放F列就填6 threshold = 0.05 '阈值，示例：5%不良率，写0.05 'IsGreater=True 代表：大于阈值就标红；False=小于阈值标红 Const IsGreater As Boolean = True Const markColor As Long = RGB(255, 200, 200) '浅红底色 '======================= Application.ScreenUpdating = False lastRow = sht.Cells(sht.Rows.Count, markCol).End(xlUp).Row lastCol = sht.UsedRange.Columns.Count If lastRow < 2 Then MsgBox "没有数据！", vbExclamation Application.ScreenUpdating = True Exit Sub End If '先清除原有填充底色 sht.Rows("2:" & lastRow).Interior.ColorIndex = xlColorIndexNone arr = sht.Range(sht.Cells(2, 1), sht.Cells(lastRow, markCol)).Value For i = 1 To UBound(arr) If IsNumeric(arr(i, markCol)) Then If IsGreater Then If arr(i, markCol) > threshold Then sht.Rows(i + 1).Interior.Color = markColor End If Else If arr(i, markCol) < threshold Then sht.Rows(i, markCol) sht.Rows(i + 1).Interior.Color = markColor End If End If End If Next i Application.ScreenUpdating = True MsgBox "异常标记完成！", vbInformation End Sub 修改位置 - markCol：监控哪一列（A=1、B=2、F=6） - threshold：临界值，百分比记得转小数，8% 填 0.08 - IsGreater：True=超过阈值标红；False=低于阈值标红 - markColor：换颜色，RGB(255,255,180)是浅黄色 注意事项 1. 表头固定第1行，判断列必须是纯数字，文本会自动跳过不报错 2. 每次运行自动清掉上次标记，不用担心颜色越标越乱 3. 合并单元格慎用，容易出现上色错位 每日持续分享办公实用技巧，专业vba开发，关注收藏不迷路。 Excel-vba一键按指定列拆分工作表，按产品型号/班组自动拆分｜数组版，万行数据不卡顿 Excel-vba台账怕崩、文件损坏？定时自动备份，后台静默存副本 Excel-vba高级录入窗体｜下拉选择+自动时间+重复校验，防重复，录完自动追加台账 别再手动找数据！Excel万能查询公式
