まず、セルを乱数を発生させた値で埋めます。
次が本番、このセルの値を読み込み、該当する色で
塗りつぶします。
意外に簡単なプログラむです。
以下、Source
Sub RANSU_01()
'
' RANSU_01 Macro
' 乱数を発生させる
Dim i, j As Integer
Dim Cnt_n As Integer
Sheets("Sheet3").Select
For i = 1 To 25
For j = 1 To 20
' 乱数を1-999の間で発生させる
Cnt_n = Int((999 - 1 + 1) * Rnd + 1)
Cells(i, j) = Cnt_n
Next j
Next i
'
'
End Sub
'--------------------------------------------------
Sub Color_01()
'
' Color_01 Macro
'
' セルの数値に応じて塗りつぶしの色を変える
Dim i, j As Integer
Dim Cel_n As Integer
Sheets("Sheet3").Select
For i = 1 To 25
For j = 1 To 20
Cel_n = Val(Cells(i, j)) 'セルの値を数値化する
Cells(i, j).Select
With Selection.Interior 'With から End Withまでは色を付ける命令
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
Select Case Cel_n 'ここでセルの値を判定し、色を指定する
Case 1 To 99
.ColorIndex = 3
Case 100 To 199
.ColorIndex = 4
Case 200 To 299
.ColorIndex = 5
Case 300 To 399
.ColorIndex = 6
Case 400 To 499
.ColorIndex = 7
Case 500 To 599
.ColorIndex = 8
Case 600 To 699
.ColorIndex = 9
Case 700 To 799
.ColorIndex = 10
Case 800 To 899
.ColorIndex = 43
Case Else
.ColorIndex = 44
End Select
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Next j
Next i
End Sub
わかお かずまさ
VegaSystems
📷📷📷📷📷📷
#LAN_PRO
#Bloguru
If you are a bloguru member, please login.
Login
If you are not a bloguru member, you may request a free account here:
Request Account