エクセル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ってなんでもできるんですね。。

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

回答No.3

tsubuyuki

＃１さんに先に種明かしをされてしまっていましたね（笑）。

要するに、私も同意見です。
もう少しわかりやすく言うと、
「セルにプルダウンによる選択肢を設けるには入力規則しかない」
ということですね。
なので、マクロで行うにしても結局は「マクロで入力規則を設定」してやるしかないのです。

> 入力規則の今のままでいいのでは？という野暮な回答はご遠慮します。
とのことですが、あえて言わせて頂きます。
> 入力規則⇒リスト⇒　”=$A$1:$A$10”　ではなく、”りんご,ばなな、みかん”のように、
できます。
添付図をご覧いただければご理解いただけると思いますが、
「元の値」は、文字列をカンマ（，）で区切ってやることでも設定可能です。

で、マクロの記録機能を使って上記を記録したのが、そのコード、ということです。

マクロにこれを組み込むとすると・・例えば
「Ｄ列に[案件名]が何か入力されていたら、同じ行のＡ列に入力規則設定、
　Ｄ列が空白だったら（消去されたら）、入力規則解除」
という使い方が考えられます。

Private Sub Worksheet_Change(ByVal Target As Range)
　　　　If Target.Column = 4 Then
　　　　　　　　If Target <> "" Then
　　　　　　　　　　　　With Range("A" & Target.Row).Validation
　　　　　　　　　　　　　　　　.Delete
　　　　　　　　　　　　　　　　.Add Type:=xlValidateList, _
　　　　　　　　　　　　　　　　　　　　AlertStyle:=xlValidAlertStop, _
　　　　　　　　　　　　　　　　　　　　Operator:=xlBetween, _
　　　　　　　　　　　　　　　　　　　　Formula1:="終了,延期"
　　　　　　　　　　　　　　　　.IgnoreBlank = True
　　　　　　　　　　　　　　　　.InCellDropdown = True
　　　　　　　　　　　　　　　　.InputTitle = "進捗入力"
　　　　　　　　　　　　　　　　.ErrorTitle = "入力値エラー"
　　　　　　　　　　　　　　　　.InputMessage = "「終了」または「延期」を選択して下さい"
　　　　　　　　　　　　　　　　.ErrorMessage = "「終了」または「延期」を選択して下さい"
　　　　　　　　　　　　　　　　.IMEMode = xlIMEModeNoControl
　　　　　　　　　　　　　　　　.ShowInput = True
　　　　　　　　　　　　　　　　.ShowError = True
　　　　　　　　　　　　End With
　　　　　　　　Else
　　　　　　　　　　　　Range("A" & Target.Row).Validation.Delete
　　　　　　　　End If
　　　　End If
End Sub

こんな感じです。

お礼

回答ありがとうございます！
>「セルにプルダウンによる選択肢を設けるには入力規則しかない」
>マクロで行うにしても結局は「マクロで入力規則を設定」してやるしかないのです。

⇒！！！

現在の入力規則はいただきました添付図の通りとなります。

いただきましたコンフィグを明日、検証させていただきます。
ご迷惑をお掛けして大変申し訳ございません。
ありがとうございます。

回答No.2

tsubuyuki

ちょっと、おっしゃっている内容の意味が良くわからないんですが。

要するに（例えばＡ２セルに設定するなら）

　　　　With Range("A2").Validation
　　　　　　　　.Delete
　　　　　　　　.Add Type:=xlValidateList, _
　　　　　　　　　　　　AlertStyle:=xlValidAlertStop, _
　　　　　　　　　　　　Operator:=xlBetween, _
　　　　　　　　　　　　Formula1:="終了,延期"
　　　　　　　　.IgnoreBlank = True
　　　　　　　　.InCellDropdown = True
　　　　　　　　.InputTitle = "進捗入力"
　　　　　　　　.ErrorTitle = "入力値エラー"
　　　　　　　　.InputMessage = "「終了」または「延期」を選択して下さい"
　　　　　　　　.ErrorMessage = "「終了」または「延期」を選択して下さい"
　　　　　　　　.IMEMode = xlIMEModeNoControl
　　　　　　　　.ShowInput = True
　　　　　　　　.ShowError = True
　　　　End With

こういうことですか？

お礼

回答をいただきましてありがとうございます。
初めて見る構文で、まだ理解が追いつきません。

明日、詳しく解析？作業を進めさせていただきます。

すみません、、軽いノリでVBAに手を付け自分が見当違いな質問をしているのは解っているつもりです。。

回答No.1

mitarashi

すみませんが、長いコードは斜め読み程度です。

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

だけなら、自動記録すれば録れますが、何が問題なのでしょうか。

下記の様に動的に入力規則を生成したいのでしょうか？（ほぼ自動記録したコードです）ただ、入力規則削除の方は、マクロ不可で開いてみないと効果が分かりませんが．．．

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Columns(1)) Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
With Target.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="終了,延期"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.IMEMode = xlIMEModeNoControl
.ShowInput = True
.ShowError = True
End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Columns(1)) Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
Target.Validation.Delete
End Sub

お礼

回答ありがとうございます！
VBA歴一週間ですが既に頭のバッファの閾値を超えそうです。

動的にリストの値を取得できる？？
リストのstringを自動で増減するという事でしょうか。。

という意味なら、静的にリストを決めたいです。
何故ならリストの文字列で、
その行を塗りつぶすパラメーターを組みたいからですが、、

すみません、明日仰ってる内容を分析させていただきます。