単一セル内での2段階リスト表示は可能ですか？

質問

Excelのリストが長い場合、二段階方法（「セル範囲に名前をつける」のと「INDIRECT関数」）がありますが、これだと項目を２つに分けなければなりません。

そうではなく、ひとつのセルで、リストが２つでてくる方法はあるのでしょうか？

たとえば47都道府県をすべてひとつのリスト内でくくると探すのが大変です。
前者の場合「地方名」という項目には以下リスト「関東」「中部」…を作成します。
1項目目で関東選択すると、2項目では「東京」「神奈川」…というようにグループ分けされた下位カテゴリのリストが表示されます。

以上の方法の例↓
https://office-hack.com/excel/pulldown-menu-interlock/

しかし目的はこのような方法ではなく、あくまでも単一セル内でのことです。
たとえば１段階目は「関東」というセルにマウスポインタを乗せると、自動で２段階目のカテゴリ「東京」「神奈川」等のリスト一覧がでてくる…という作成方法ができるのでしょうか？
ネットなどではよく見かけますが…。

回答No.1

misatoanna · ベストアンサー

一般機能ではできませんので、マクロ処理です。

下図のように、Sheet2のA列に地方名が、B列に都道府県名が列記されているとします。
1.A1:A6に「地方名」という名前をつけています。
2.B1:B7に「北海道・東北」という名前をつけています。
3.B8以下にも、ブロックごとに該当するA列の名前がついています。
↓
Sheet1のA1に、Sheet2のA1:A6を元の値(=地方名)とした入力規則のリストを設定します。

以上を仮定した場合の一例です。

Sheet1のシートタブを右クリックし、メニューにある"コードの表示"から開くウィンドウに以下を記述したら、そのウィンドウを閉じます。
-------
Private Sub Worksheet_Change(ByVal Target As Range)
　Dim chk As Range, Area As String
　If Target.Address(0, 0) <> "A1" Then Exit Sub
　Set chk = Worksheets("Sheet2").Range("地方名").Find(Target.Value)
　If chk Is Nothing Then
　　Area = "=地方名"
　Else
　　Area = "=" & Target.Value
　End If
　With Target.Validation
　　.Delete
　　.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
　　　　　　　　Operator:=xlBetween, Formula1:=Area
　End With
End Sub
-------

Sheet1のA1で地方名を選択すると、同じA1のリスト内容が対応する都道府県名になり、都道府県を選択すると、元の地方名リストに変わります。

お礼

補足について、勘違いしておりました。

添付画像のとおりに試したところ、成功しました！

たとえば「関東」（地方名）を選択して固定表示させたあと、再度「▽」をクリックすると、下位カテゴリ（都道府県名）がでてくるということですね。

ネットではポインタをたとえば関東に乗せると、自動で下位カテゴリがでてきてそれを選択しますが、そこまでできないということでしょうか。
ちょっとイメージとは違っていたのですが、おおむね満足しております。

補足

ご回答ありがとうございます。

sheet2

B列
1 青森県
2 岩手県
3 宮城県
4 秋田県
5 山形県
6 福島県

7 東京
8 神奈川
9 茨木
10 栃木
11 群馬
12 埼玉

と入力。

↓
A1～A6を選択し、「名前の定義」で「北海道・東北」とつけた。
↓
A7～A13を選択し、「名前の定義」で「関東」とつけた。
↓
Sheet1のA1に、Sheet2のA1:A6を元の値(=北海道・東北)とした入力規則のリストを設定した。
↓
Sheet1のA1に、Sheet2のA7:A12を元の値(=関東)とした入力規則のリストを設定した。

このような設定をしたところ、確かにシートのA2、A3はそれぞれ「青森」等、「東京」等のリストが作られました。
しかしA列はには何を入れるのでしょう？
B1～B6は北海道・東北ですので、A1～A6すべて「北海道・東北」と入力するのでしょうか？

ちなみにこの時点でマクロは入っています。

回答No.4

misatoanna

>アプリケーション定義またはオブジェクト定義のエラー
プロシージャ内のどの行でエラーが起きるのでしょうか。

>二段階目のリストを出そうと、リストの一つをクリックしたところ
入力規則(リスト)を設定したセルは、複数あるのでしょうか。

お礼

すいません、NO.2へのお礼に書いてしまいましたが、
↓

Set chk = Worksheets("Sheet2").Range("地方名").Find(Target.Value)

ワークシートの名前を正しいものに入れ替えたところ、正常にできました。

誠にありがとうございました！

回答No.3

misatoanna

>入力規則設定セルをD10にして
>If Target.Address(0, 0) <> "A1" Then Exit Sub
>を
>If Target.Address(0, 0) <> "D10" Then Exit Sub
>にしたが、２段階の部分は表示されない。

こちらでは、対象をどのセルにしても、この部分の変更だけで、問題なく動作していますが‥‥
それ以外の設定も正しくされていると思いますので、なぜ動作しないのか、わかりません。

補足

リスト自体はつくれましたが、二段階目のリストをだそうと、リストの一つをクリックしたところ

実行時エラー　1004
アプリケーション定義またはオブジェクト定義のエラー

とでます…。

回答No.2

misatoanna

マウスポインタの位置を取得することはVBAでもできるようですが、デスクトップの左上端を起点としたピクセル値をExcelウィンドウ内のセル位置に置き換える処理は、かなり難しそうですし、私にそのスキルはありません。

なお、入力規則ではなくAxtiveXのコンボボックスでしたら、次のような記述で、ポインタがコンボボックス上に当てられた時点でドロップダウンさせることはできますので、工夫すれば何とかなるかも知れませんね。
-------
Private Sub ComboBox1_MouseMove _
(ByVal Button As Integer, ByVal Shift As Integer, _
ByVal X As Single, ByVal Y As Single)
　ComboBox1.DropDown
End Sub

お礼

Set chk = Worksheets("Sheet2").Range("地方名").Find(Target.Value)

ワークシートの名前を正しいものに入れ替えたところ、正常にできました。

誠にありがとうございました！

補足

ありがとうございます。

回答1についてのマクロなのですが、都道府県は例です。
今後、この構文を使って同じタスクに利用したいと思いますが、リスト内容とワークシート上での位置が変わる場合、リスト内容は

Set chk = Worksheets("Sheet2").Range("地方名").Find(Target.Value)
　If chk Is Nothing Then
　　Area = "=地方名"

↑の"=地方名"を入れ替えればよいと思いますが、リストを作りたい位置については、

If Target.Address(0, 0) <> "A1" Then Exit Sub

の"A1"のところを、差し替えればよいと思いますが、二段階目にならず今困っております。

sheet2のリスト候補をsheet1の「D10」に呼び出すとき、

If Target.Address(0, 0) <> "D10" Then Exit Sub

としたのですが、２段階の部分は表示されません…。