| |
▼ringotyanZ さん：
こんばんは。
>列の数値に変化がある度に数字の色を変化させたいのですが可能でしょうか？
>数値が上った場合は赤に、下がった場合は青に、前の値と変わらない場合は色は前の色と同じに、といった具合にセルの数字に色を付けることは可能ですか？
>
>マクロを作りたい元データは下記の通りなのですが、例えば、3列目の数字が387→388に上った場合数字を赤色に、その後数値が変わらず388のままなら数字は赤のまま、388→386など下がった場合数字を青に、その後値が変わらないなら以下の数字は青色のままに、といった具合に、これを列の最後まで繰り返させたいのです。
>
>よろしくお願いします。
>
>
以下のデータがSheet1というシート名のセルＡ１から入っているとします。
>2006/3/8 9:53 387 387.78 100
>2006/3/8 9:54 387 387.74 200
>2006/3/8 10:04 387 387.72 100
>2006/3/8 10:04 388 387.73 200
>2006/3/8 10:10 388 387.74 200
>2006/3/8 10:27 386 387.63 300
>2006/3/8 10:46 386 387.6 100
>2006/3/8 10:55 386 387.44 500
>2006/3/8 10:55 386 387.36 300
>2006/3/8 10:55 386 387.25 500
>2006/3/8 12:30 385 385.82 10500
>2006/3/8 12:30 385 385.81 200
>2006/3/8 12:35 386 385.81 100
>2006/3/8 12:37 386 385.81 400
Thisworkbookのモジュールに
'=======================================================
Private Sub Workbook_Open()
Dim rng As Range
With Worksheets("sheet1")
For Each rng In .Range("a1").CurrentRegion
If rng.Column > 2 Then
rng.ID = Str(rng.Value)
'rng.Font.ColorIndex = 0
End If
Next
End With
End Sub
Sheet1のシートモジュールに
'=================================================================
Private Sub Worksheet_Change(ByVal Target As Range)
Dim t_target As Range
Dim crng As Range
Set t_target = Application.Intersect(Target, Range("c:e"))
If Not t_target Is Nothing Then
For Each crng In t_target
With crng
If Val(.ID) < Val(.Value) Then
.Font.ColorIndex = 3
ElseIf Val(.ID) > Val(.Value) Then
.Font.ColorIndex = 5
End If
.ID = Str(.Value)
End With
Next
End If
End Sub
データチェック対象セル範囲はＣ列〜Ｅ列とします。
尚、上記コードを追加して一度保存後して閉じた後
再度開いてみて確認してください。
|
|
ichinose
- 06/3/8(水) 19:34 -
