Excel 3段階のドロップダウンリスト作成で1段目ができない

お世話になってます。
Excel2013なのですが、画像のようなリストがあります。
3行目が項目になっており、B列に出荷先とあり、データとして国内と海外があります。
D列は、商品区分とあり、テレビやビデオなどが記載されています。
E列~は、各商品の具体的な型名などのデータがあります。
それぞれの列には、3行目の項目と同じ名前を定義してあります。
C列の作業列は、D列の商品区分の行と対応しており、海外向けは、テレビやビデオ、国内向けは、エアコンやパソコンというようになっています。

これで、3段階のドロップダウンリストを作りたいのですが、現在は、別シートにて、リストの範囲を「=出荷先」で1段目を作り、2段目で「=商品区分」、3段目で、「=INDIRECT(D5)」としています。
2段目と3段目はつながっているのですが、1段目は連動しません。
これを3連動させたいのですが、どうすればよいでしょうか？データを追加してもそのまま誰でも使用できるように、1段目と3段目のリストの内容はそのままで、2段目のリストの数式で解決できそうな感じはしますが、可能でしょうか？
申し訳ありませんが、よろしくお願いいたします。

質問者からの補足コメント

• こんにちは。早速ありがとうございます。やはり簡単にはいかないんですね。
  これでできたんですが、実際は、データが多く上下に並べるのは困難です。
  そこで思ったんですが、別シートに、作業列と商品区分の対応が今の表では難しいようなので添付のような画像の表を別シートで作れば、1段目のリストの内容を新しく作ったシートの作業列に名前をつけて指定し、2段目は、=INDIRECT(C5)で、3段目は現状のままでいけそうなのでそうするか、と思いやってみるとうまくできました。
  別シートへの抜き出しはVBAで行ってみました。投稿文字数が不足するので別に投稿します。
  最初はピボットテーブルでやろうとしたけど、うまくすればできるんだろうけど、こちらはうまくできませんでした。

  
  No.1の回答に寄せられた補足コメントです。 補足日時：2017/11/12 11:58

• 一応別シートへ1段目と2段目用の表を作成することで自己解決しましたので、投稿しておきます。
  表の作成は、元の表からVBAで行いました。
  投稿にあたり、文字数制限があるため、途中で切りながらの投稿になります。
  
  Sub test()
  
  Dim sheetobj As Worksheet
  Dim i, k, l As Long
  Dim lastRow1 As Long
  Dim lastRow2 As Long
  Dim lastcol As Long
  Dim i As Long
  
  Application.ScreenUpdating = False
  
  Set sheetobj = ThisWorkbook.Worksheets("Sheet3")
  
  sheetobj.AutoFilterMode = False 'オートフィルタを解除しておく
  
  まずは、ここまでで、続きを投稿します。

    補足日時：2017/11/12 12:09

• Worksheets("Sheet2").Range("C:D").Copy sheetobj.Range("D:E")
  Worksheets("Sheet2").Range("C:D").Copy sheetobj.Range("B:C")
  
  lastRow1 = sheetobj.Cells(Rows.Count, "D").End(xlUp).Row 'D列の最終行
  
  'フィルタオプションでD3～を重複なしでA3～に抽出
  Range(sheetobj.Cells(3, "D"), sheetobj.Cells(lastRow1, "D")) _
  .AdvancedFilter Action:=xlFilterCopy, copytorange:=sheetobj.Range("A3"), unique:=True

    補足日時：2017/11/12 12:15

• lastRow2 = sheetobj.Cells(Rows.Count, "A").End(xlUp).Row 'A列の最終行
  
  sheetobj.Range(Cells(4, "A"), Cells(lastRow2, "A")).Copy
  sheetobj.Range("E3").PasteSpecial Paste:=xlPasteValues, Transpose:=True
  
  lastcol = sheetobj.Cells(3, Columns.Count).End(xlToLeft).Column 'A列の最終行

    補足日時：2017/11/12 12:16

• For i = 5 To lastcol 'B列の作業列4行目からデータの最終行までを繰り返す
  Range(sheetobj.Cells(3, "B"), sheetobj.Cells(lastRow1, "C")).AutoFilter Field:=1, Criteria1:=sheetobj.Cells(3, i) '作業列B3セルにフィルタをかけ、E3セルから右に最終列まで項目と一致するものを絞り込んで貼り付けていく
  Range(sheetobj.Cells(4, "C"), sheetobj.Cells(lastRow1, "C")).SpecialCells(xlCellTypeVisible).Copy sheetobj.Cells(4, i)
  Next i

    補足日時：2017/11/12 12:18

• sheetobj.AutoFilterMode = False
  sheetobj.Range("A:A").Copy sheetobj.Range("D:D")
  sheetobj.Range("A:C").Clear
  sheetobj.Range("D4").CurrentRegion.ClearFormats
  sheetobj.Range("D4").CurrentRegion.Borders.LineStyle = xlContinuous
  sheetobj.Range(sheetobj.Cells(3, 4), sheetobj.Cells(3, lastcol)).Interior.Color = vbYellow
  Application.ScreenUpdating = True
  End Sub
  
  以上です。コードに問題があればご指摘下さい。
  ありがとうございました。

    補足日時：2017/11/12 12:19

No.2 ベストアンサー 回答者： tom04 回答日時： 2017/11/12 16:47

No.1です。

VBAのコードは詳しく見ていません。

INDIRECT関数をお使いだというコトは各型番を名前定義しているのですね？
すなわち、型番毎のデータ数にばらつきがある場合、リストに空白が表示されるのでは？
もしくはいちいちデータ数を範囲指定し名前定義しているのですかね？

最初の数式が面倒ですが、一度数式を入れておけば
今後データ数（品名・型番のとちらでも）が増えてもそのまま対応でき、
リスト表示されるのはデータ数分だけなので、No.1の方法がおススメなのですが・・・

＞実際は、データが多く上下に並べるのは困難です。
前回は判りやすいように10行程度のデータ数の表にしていました。

↓の画像のように「国内」と「海外」のデータを100行程度離していれば
数式を少し変えるだけで大丈夫です。

あくまでSheet2が画像の配置になっているという前提です。

Sheet1のC・D列は前回の数式のままでOKです。

尚、「元の値」の欄の文字数制限があるようなので、
Sheet2の2行目すべてを範囲指定　→　国内　と名前定義
Sheet2の102行目すべてを範囲指定　→　海外　と名前定義　しておきます。

Sheet1のE列を範囲指定　→　リスト　→　元の値の欄に
=IF(COUNTIF(国内,D5),OFFSET(Sheet2!A$2,1,MATCH(D5,国内,0)-1,COUNTA(OFFSET(Sheet2!A$3:A$100,,MATCH(D5,国内,0)-1))),OFFSET(Sheet2!A$102,1,MATCH(D5,海外,0)-1,COUNTA(OFFSET(Sheet2!A$103:A$200,,MATCH(D5,海外,0)-1))))

という数式を入れます。
これでSheet2のデータ変動にも対応できます。
（もちろん品名が増えても構いません）

※　余計なお世話かもしれませんが、VBAをつかうのであれば
Sheet1のC・D列が変更になった場合のコードにしてみてはどうでしょうか？
↓のコードをSheet1のシートモジュールにしてみてください。

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("C:D")) Is Nothing Or Target.Count > 1 Then Exit Sub
If Target.Row < 5 Then Exit Sub
With Target
If .Column = 3 Then
.Offset(, 1).Resize(, 2).ClearContents
Else
.Offset(, 1).ClearContents
End If
End With
End Sub

あくまで参考程度で・・・m(_ _)m

この回答へのお礼

いつもどうもありがとうございます。
名前の定義なしで項目が増えてもそのまま使えるのは魅力的だと思いました。関数は、複雑で分かりにくいですが、2段までの階層リストなら、上下に並べなくてもいけるのですかね？それなら、とてもいいですね。今度使いたいです。今まで、階層リストは名前の定義をしないとできないと思っていました。

>INDIRECT関数をお使いだというコトは各型番を名前定義しているのですね？
>すなわち、型番毎のデータ数にばらつきがある場合、リストに空白が表示されるのでは？
>もしくはいちいちデータ数を範囲指定し名前定義しているのですかね？
各型番というより、作業列、海外、国外、テレビ、ビデオなど2行目～に対して名前定義をしています。
項目を増やした場合など、列に対しての名前の定義もvbaで行うようにしています。
下の方は、空白になりますが、2行目は空白なので、先頭からリスト選択できます。

お礼日時：2017/11/12 17:34

No.1 回答者： tom04 回答日時： 2017/11/11 20:55

こんばんは！

お示しの表のような配置ではかなり厄介だと思うので、
元の表を少し変えてみました。
（簡単にできる方法があればごめんなさい。）

↓の画像のような感じで、Sheet2に「国内」と「海外」の表を別々に作成しておきます。

とりあえず各品目10個までの型番対応ができるようにしてみました。

Sheet1のC列の入力規則　→　リスト　→　元の値の欄には二つだけなので
国内,海外
と手入力します。

D列を範囲指定　→　・・・中略・・・　→　元の値の欄に
=OFFSET(Sheet2!$1:$1,MATCH(C5,Sheet2!A:A,0),,,COUNTA(OFFSET(Sheet2!$1:$1,MATCH(C5,Sheet2!$A:$A,0),,1)))

という数式を入れます。

E列を範囲指定　→　・・・中略・・・　→　元の値の欄に
=IF(COUNTIF(Sheet2!$2:$2,D5),OFFSET(Sheet2!A$2,1,MATCH(D5,Sheet2!$2:$2,0)-1,COUNTA(OFFSET(Sheet2!A$3:A$12,,MATCH(D5,Sheet2!$2:$2,0)-1))),OFFSET(Sheet2!A$15,1,MATCH(D5,Sheet2!$15:$15,0)-1,COUNTA(OFFSET(Sheet2!A$16:A$25,,MATCH(D5,Sheet2!$15:$15,0)-1))))

という数式を入れると画像のような感じになります。
（数式はこの画面からそのままコピー＆ペーストしてください）

※　C列　→　D列　→　E列の順にリストで決定していくという前提です。

もし、C・D列を変更したい場合、右側の列に表示があるとそのままです。
C列変更でD・E列消去、D列変更でE列消去！
というコトは可能ですが、この場合はVBAになります。m(_ _)m