作者qsss (Qooo)
看板Visual_Basic
标题Re: [VBA ] 关於资料的比对、填入背景色、搬移
时间Wed Apr 14 09:49:02 2010
※ 引述《nomorelife (nomorelife)》之铭言：
: 问题1之简化资料
: A
: 1 133.5
: 2 134
: 3 134
: 4 133.5
: 5 133.5
: 6 133.5
: 7 133
: 8 133.5
: 9 134
: 10 133.5
: 这份资料中，小弟希望能由A10格的数值开始向上比对。
: 若A9数值大於A10，储存格填入红色；若A9数值小於A10，储存格填入绿色；
: 若相等则不动作。
: 以这份资料而言，应呈现A10(无颜色)、A9(红色)、A8(绿色)、A7(绿色)、A6(红色)、
: A5A4(无颜色)、A3(红色)、A2(无颜色)、A1(绿色)。
: 请问各位大大，该如何写才能达成呢？
Sub Change_Color()
Dim R, C As Integer
R = 1
C = 1
Do While ActiveSheet.Cells(C, R).Value <> ""
If ActiveSheet.Cells(C + 1, R).Value <> "" Then
If ActiveSheet.Cells(C, R).Value < ActiveSheet.Cells(C + 1,
R).Value Then
ActiveSheet.Cells(C, R).Interior.ColorIndex = 50
ActiveSheet.Cells(C, R).Interior.Pattern = xlSolid
ElseIf ActiveSheet.Cells(C, R).Value > ActiveSheet.Cells(C + 1,
R).Value Then
ActiveSheet.Cells(C, R).Interior.ColorIndex = 3
ActiveSheet.Cells(C, R).Interior.Pattern = xlSolid
Else
ActiveSheet.Cells(C, R).Interior.ColorIndex = xlNone
End If
End If
C = C + 1
Loop
End Sub
--
※ 发信站: 批踢踢实业坊(ptt.cc)
◆ From: 203.73.240.88
1F：推 nomorelife:收到!! 谢谢大大，小弟马上试试看。 04/15 20:08