Excel VBAを始めるには(012)

今回は、セルの値に応じた色での塗りつぶしです。

まず、セルを乱数を発生させた値で埋めます。

次が本番、このセルの値を読み込み、該当する色で
塗りつぶします。

意外に簡単なプログラむです。

以下、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
#kuma

People Who Wowed This Post

×
  • 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
This user only allows bloguru members to make comments.
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