Sub Click()
Dim A, B, d, rng, i%, j%, x$
Set d = CreateObject("scripting.dictionary")
A = Sheets("内容").Range("a1").CurrentRegion
With Sheets("图表")
B = .Range("a2").CurrentRegion
.Range("1:" & UBound(B, 2)).Interior.ColorIndex = 0
.Activate
End With
For i = 2 To UBound(A)
d(A(i, 1) & "|" & A(i, 2)) = A(i, 3)
Next i
For i = 2 To UBound(B)
For j = 2 To UBound(B, 2)
Set rng = Cells(i + 1, j)
'如果图表要找的,内容表里有
If d.exists(B(1, j) & "|" & B(i, 1)) Then
x = d(B(1, j) & "|" & B(i, 1))
'如果图表的值为可空,就是黄色
If B(i, j) = "" Then
rng.Interior.ColorIndex = 6
Else
'如果值相同,就是绿色
If B(i, j) = x Then rng.Interior.ColorIndex = 10
'如果图表的值大于内容表的值,就是兰色
If Len(B(i, j)) > Len(x) Then rng.Interior.ColorIndex = 8
'如果图表的值小于内容表的值,就是红色
If Len(B(i, j)) < Len(x) Then rng.Interior.ColorIndex = 3
End If
End If
Next j
Next i
End Sub
找到后变色.rar
(17.75 KB, 下载次数: 27)