Excel-VBA セルに背景色その2

少し簡単にパターンの紹介。
これはセルの値の部屋番号での着色。
すべてSelect Case文、
前後に着色のWith-EndWithを入れ、その中で
Case で値を決め、着色します。

以下、Source
Sub Room_Color()
'
' Room_Color Macro
'
' Helper Sheet上の部屋番号に着色します。

Sheets("HELPER").Select


Dim i, j, k As Long

Dim Rom_c As String

For i = 2 To 51

For j = 5 To 33

Rom_c = Cells(j, i)

If Rom_c = "" Then

GoTo CONTINUE:
Else

Rom_c = Left(Rom_c, 3)

Cells(j, i).Select

With Selection.Interior

.Pattern = xlSolid
.PatternColorIndex = xlAutomatic

Select Case Rom_c


Case "102"

.ColorIndex = 3

Case "103"

.ColorIndex = 4

Case "105"

.ColorIndex = 50

Case "106"

.ColorIndex = 6

Case "107"

.ColorIndex = 7

Case "108"

.ColorIndex = 8

Case "110"

.ColorIndex = 10

Case "111"

.ColorIndex = 12

Case "112"

.ColorIndex = 14

Case "201"

.ColorIndex = 15

Case "202"

.ColorIndex = 16

Case "203"

.ColorIndex = 17

Case "205"

.ColorIndex = 19

Case "206"

.ColorIndex = 20

Case "207"

.ColorIndex = 42

Case "208"

.ColorIndex = 22

Case "210"

.ColorIndex = 23

Case "211"

.ColorIndex = 24

Case "212"

.ColorIndex = 33

Case "213"

.ColorIndex = 34

Case "215"

.ColorIndex = 35

Case "216"

.ColorIndex = 36

Case "217"

.ColorIndex = 37

Case "218"

.ColorIndex = 38

Case "220"

.ColorIndex = 39

End Select


.TintAndShade = 0
.PatternTintAndShade = 0

End With

'Debug.Print Rom_c

End If

CONTINUE:



Next j


Next i

Range("A1").Select


'
End Sub



わかお かずまさ
VegaSystems

📷📷📷📷📷📷
#LAN_PRO
#Bloguru
#kuma

ワオ!と言っているユーザー

×
  • ブログルメンバーの方は下記のページからログインをお願いいたします。
    ログイン
  • まだブログルのメンバーでない方は下記のページから登録をお願いいたします。
    新規ユーザー登録へ
コメントの投稿にはメンバー登録が必要です。
ブログルメンバーの方は下記のページからログインをお願いいたします。
ログイン
まだブログルのメンバーでない方は下記のページから登録をお願いいたします。
新規ユーザー登録へ