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

People Who Wowed This Post

今日の御嶽山(2022.11.05)

今日の御嶽山
雲が少しあります、先日の雨はお山は雪になり、冠雪が始まりました。


わかお かずまさ
VegaSystems

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

People Who Wowed This Post

今日の日の出(2022.11.05)😄

今日の日の出、位置は猿投山の頂上を過ぎ、南麓にかかりました。
今日は、少し雲があり、発色が綺麗です。


わかお かずまさ
VegaSystems

📷📷📷📷📷📷
#LAN_PRO
#Bloguru
#kuma_ichinomiya
#VegaSystems
#photography_Ichinomiya
#S1H
#sunrise_ichinomiya
#Sunset_ichinomiya
#日の出_一宮
#夜明け_一宮
#kuma

People Who Wowed This Post

まもなくスキーシーズン

あと一ヶ月でスキーシーズンが始まります。
リフトを降りて、ストックベルトを装着するの少し手間取る構造だったので
新しいアイテムにしてみました。
はめるのは押し込むだけ、離脱にはTOPのボタンで外れます、転倒時等の場合、
強い力がかかると外れる構造です。


わかお かずまさ
VegaSystems

📷📷📷📷📷📷
#LAN_PRO
#Bloguru
#kuma_ichinomiya
#VegaSystems
#photography_Ichinomiya

#SKI
#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