エクセルVBA プルダウンのリスト 指定範囲以外で

質問

こんにちは。

現在、業務で案件の簡単な進捗表を作成しています。

VBAで他の、ご質問/回答を基にマクロを組んで遊んで？いますが、
以下の問題に困っています。

現在作成中のエクセルファイルのステータスですが、

(1)A列に”入力規則”でプルダウン（終了,延期）を設けています。

(2)マクロでA列のプルダウンで”終了”の場合はA:AFまでグレーアウト
　同様に”延期”の場合はA:AFまで黄色

(3)マクロでC列に”土”ならフォントを青で日なら赤

やりたい事ですが、
(1)の事を”マクロ”でやりたいんです。

リストで元の値を指定してマクロを組む方法は、
いくらでもネット上に転がっているのですが、

元の値を範囲ではない方法、つまり、

入力規則⇒リスト⇒　”=$A$1:$A$10”　ではなく、”りんご,ばなな、みかん”のように、
マクロのコード内で範囲を構成したい、、、

うまくいえませんが、簡単に言うと、プルダウンメニューが2つしかないのに、
わざわざ、データ用の別シートを作ったりしたくない、、、という理由です。

このプルダウンメニューのマクロを今の下記コードに組み込ませたいのですが、
どなたか、ご教授願います。

※今後の事も考え拡張性（プルダウンメニューの追加とか）を考慮したものを書きたいです。

マクロが面白くなってきたから勉強しているのであって、
入力規則の今のままでいいのでは？という野暮な回答はご遠慮します。

上記の(2)と(3)を他の質問から見よう見まねで組み合わせ、
動作は確認出来ています。

以下が組み合わせたものとなります。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim RngA1 As Range
Dim RngA2 As Range
Dim RngC1 As Range
Dim RngC2 As Range
Dim RngE1 As Range
Dim RngE2 As Range
Dim rr As Range
Dim i As Long
Dim c As Range
Dim myColor As Long
Dim clr As Integer

'#########################Ａの処理#########################
Set RngA1 = Range("A:A") '判定の対象となる列
Set RngA2 = Range("A:AF") '色を変える列

If Intersect(Target, RngA1) Is Nothing Then GoTo SYORI_C

For Each c In Intersect(Target, RngA1)
With c
Select Case .Value

Case "終了": myColor = 48
Case "延期": myColor = 27
Case Else

myColor = xlColorIndexNone
End Select
Intersect(c.EntireRow, RngA2).Interior.ColorIndex = myColor
End With
Next

'#########################Cの処理#########################
SYORI_C:
Set RngC1 = Range("V:V") '判定の対象となる列
Set RngC2 = Range("V:W") '色を変える列

If Intersect(Target, RngC1) Is Nothing Then GoTo SYORI_E

For Each c In Intersect(Target, RngC1)
With c
Select Case .Value
Case "無し": myColor = 48
Case Else
myColor = xlColorIndexNone
End Select
Intersect(c.EntireRow, RngC2).Interior.ColorIndex = myColor
End With
Next

'#########################Eの処理#########################
SYORI_E:
Set RngE1 = Range("X:X") '判定の対象となる列
Set RngE2 = Range("X:Y") '色を変える列

If Intersect(Target, RngE1) Is Nothing Then GoTo SYORI_G

For Each c In Intersect(Target, RngE1)
With c
Select Case .Value
Case "無し": myColor = 48
Case Else
myColor = xlColorIndexNone
End Select
Intersect(c.EntireRow, RngE2).Interior.ColorIndex = myColor
End With
Next

'########################################################
SYORI_G:
If Intersect(Target, Range("C:C")) Is Nothing Then Exit Sub

For Each rr In Intersect(Target, Range("C:C"))
For i = 1 To Len(rr.Value)
Select Case Mid$(rr.Value, i, 1)

Case "土": clr = 5
Case "日": clr = 3

Case Else: clr = xlAutomatic
End Select
rr.Characters(i, 1).Font.ColorIndex = clr

Next
Next

'########################################################

End Sub

回答No.4

mitarashi

#1です。
「動的に」というのは、A列のあるセルを選択した時だけ入力規則が生成され、リストからの選択が済むと入力規則が消されるという意味です。リストの中味はそろそろコードをお読みになってお分かりかもしれませんが、コード中で指定（固定の値）しています。（ただし、消えたかどうかはマクロ無効でブックを開いてみないと確認のしようがありません）

「VBAの森にようこそ」という感じですが、いらぬお節介を言わせていただくと、

シートモジュールのイベントマクロをだらだらと長く書くとすっきりしないので、処理が複雑になるときは、後処理は別のプロシージャに任せる方が良いとおもいます。
Private Sub Worksheet_Change()
call 下請け処理1
End Sub

Private Sub Worksheet_SelectionChange()
call 下請け処理2
End Sub

あと、当方はエラー処理以外のGotoは禁じ手にしていますがなんとかなるものです。
ご参考まで。

お礼

こんにちは！

！！！！

”動的に”
仰るとおり、コードを読んで理解できました！
（正確にはまだ読み切れませんが何となく雰囲気？で）

プロシージャー～
なるほど、これまたまだよく解りませんが基礎設計を
組んで詳細設計とを別々にして解りやすいようにする？

といった感じでしょうか。。
なんとなく意味はわかりました。

今、ネットで拾ったコードを後付けでボンボンくっ付けて、
収集つかなくなってる状況です。。

VBAってなんでもできるんですね。。

ありがとうございます！！！！！