Re: [VBA ] 關於資料的比對、填入背景色、搬移

[qsss (Qooo)]

※ 引述《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
推 nomorelife:收到!! 謝謝大大，小弟馬上試試看。