1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
| Sub 根据判据自动填充颜色()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim ws As Worksheet
Dim dataCell As Range
Dim criteria As String
Dim rowNum As Long, colNum As Long
Dim val As Double, tolerance As Double
Dim maxVal As Double, minVal As Double
Dim rgbGreen As Long, rgbRed As Long
' 设置颜色值
rgbGreen = RGB(144, 238, 144) ' 浅绿色
rgbRed = RGB(255, 182, 193) ' 浅红色
' 设置工作表和范围
Set ws = ActiveSheet
Set rngData = ws.Range("I5:CN44") ' 数据区域
' 清除原有颜色
rngData.Interior.ColorIndex = xlNone
' 遍历每一行 (5到44行)
For rowNum = 5 To 44
' 检查对应的判据行是否存在 (G5对应I5行，G6对应I6行...)
If rowNum <= 44 Then
criteria = Trim(ws.Cells(rowNum, "G").Text)
' 只处理非空判据
If criteria <> "" Then
' 情况1: 简单数值 (如19.50)
If IsNumeric(criteria) Then
val = CDbl(criteria)
' 遍历I到CN列 (9到98列)
For colNum = 9 To 98
Set dataCell = ws.Cells(rowNum, colNum)
' 只处理有数据的单元格
If Not IsEmpty(dataCell) And IsNumeric(dataCell.Value) Then
If CDbl(dataCell.Value) = val Then
dataCell.Interior.Color = rgbGreen
Else
dataCell.Interior.Color = rgbRed
End If
End If
Next colNum
' 情况2: 带公差的值 (如-25±3)
ElseIf InStr(criteria, "±") > 0 Then
Dim parts() As String
parts = Split(criteria, "±")
If UBound(parts) = 1 Then
If IsNumeric(Trim(parts(0))) And IsNumeric(Trim(parts(1))) Then
val = CDbl(Trim(parts(0)))
tolerance = CDbl(Trim(parts(1)))
minVal = val - tolerance
maxVal = val + tolerance
For colNum = 9 To 98
Set dataCell = ws.Cells(rowNum, colNum)
If Not IsEmpty(dataCell) And IsNumeric(dataCell.Value) Then
If CDbl(dataCell.Value) >= minVal And CDbl(dataCell.Value) <= maxVal Then
dataCell.Interior.Color = rgbGreen
Else
dataCell.Interior.Color = rgbRed
End If
End If
Next colNum
End If
End If
' 情况3: 不等式 (如≤13)
ElseIf Left(criteria, 1) = "≤" Or Left(criteria, 1) = "<" Then
If IsNumeric(Mid(criteria, 2)) Then
maxVal = CDbl(Mid(criteria, 2))
For colNum = 9 To 98
Set dataCell = ws.Cells(rowNum, colNum)
If Not IsEmpty(dataCell) And IsNumeric(dataCell.Value) Then
If CDbl(dataCell.Value) <= maxVal Then
dataCell.Interior.Color = rgbGreen
Else
dataCell.Interior.Color = rgbRed
End If
End If
Next colNum
End If
End If
' 其他格式的判据不做处理
End If
End If
Next rowNum
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "颜色填充完成!", vbInformation
End Sub
|