[[20101104215614]]　『ドロップダウンリスト』（FA）　ページの最後に飛ぶ

『ドロップダウンリスト』（FA）

いつもお世話になっております。
現在製作中のファイルで困っております。
皆さんのお力をお借りしたくご質問させて頂きます。
下記のような3段階のドロップダウンリストをすることは可能でしょうか？

下記のような製品リストがあります。

　　A　　　　 B　　　　　C　　　　　　　D 　　　　　E 　　　　　 F　　　・・・・

1　客先名　製品番号　モデル番号　製品名　　　価格　　　　色　　　・・・・・

2　A社　　 P12345 　　　 - 　　　　　　カローラ　 10000　　　青　　　・・・・・

3　A社　　 P15675 　　　 - 　　　　　パッソ　　 5000　　　白　　　・・・・・

4　B社　　 AW1564 　　　 - 　　　　　ムーブ　 6500　　　　黒　　　・・・・・

5　C社　　 WSER5 　　　SS115 　　　　ライフ　　7000　　　　シルバー　・・・・・

6　D社　　 15R65615 　　　 - 　　　　ランサー　　12000　　　赤　　　　・・・・・

7　D社　　 15R65615 　　　 - 　　　　ランサー　　12000　　　白　　　　・・・・・

8　D社　　 15R65615　　　 - 　　　　ランサー　　12000　　　青　　　　・・・・・

この表は新車が発表されればどんどん追加されます。

別ファイルで下記のような受注表があります。

       A           B            C            D          E          F        G　         H          I      ・・・・・

1 製造番号　　受注日　　客先伝票番号　　客先名　　製品番号　モデル番号　製品名　　台数　　　　色

2 AA2010-001 10/11/4 KTAA10101 　　　　A社　　　 P12345 　　　　 - 　　　カローラ　　　　8　　　　青

3 AA2010-002 10/11/4 MTAI1566-145 　　　D社　　　15R65615 　　　　 - 　　　ランサー　　　　1 　　　青

4 AA2010-003 10/11/4 MTAI1566-148 　　　D社　　　 15R65615 　　　　 - 　　　ランサー　　　　1 　　　赤

5 AA2010-004 10/11/4 MTAI1566-165 　　　D社　　　 15R65615 　　　　 - 　　　ランサー　　　5 　　　白

受注表で客先名をドロップダウンリストから選択すると、製品名のドロップダウンリストにはその会社の製品だけが表示されます。
さらにVLOOKUPで製品番号からモデル番号や製品名をリンクさせるまではできたのですが、
D社のように製品番号や製品名が同じで色が違う場合は想定していませんでした。
色をドロップダウンリストで選択することは可能でしょうか？
また製品リストで、新車が追加された場合に自動でドロップダウンリストに表示させるにはどうすればいいのでしょうか？

ご教授の方、宜しくお願い致します。

製作中のエクセル2007
使用想定、Excel2000、Excel2003、Excel2007
製作中のＯＳ、ＸＰ
使用想定ＯＳ、ＸＰ

 色の選択について。
 >客先名をドロップダウンリストから選択すると、製品名のドロップダウンリストにはその会社の製品だけが表示されます。
 これが製品名のリストに「A社」「B社」と「名前」を付けて、入力規則で「=INDIRECT(D2)」のようにしているのであれば
 同じように色のリストに「カローラ」等と製品名の「名前」を付けて入力規則で「=INDIRECT(G2)」のようにしてはどうでしょうか？
 (独覚)

独覚様

ご返答ありがとうございます。また返信遅くなり申し訳ありません。
入力規則はINDIRECTを使用していませんでした。
このようなやり方もあるのですね。

下記の例で試してみたところ、
私の名前の付け方が悪いのか上手くいかない部分があります。
再度ご教授願います。

①客先名のドロップダウンリストがA社A社B社C社D社D社D社と重複してしまいます。
名前の定義ですが、名前を客先名、参照範囲を=Sheet6!$A$2:$A$8としました。
A社も=Sheet6!$B$2:$B$3とし、D社は=Sheet6!$B$6:$B$8としました。
D社もドロップダウンリストを見ると重複しているので、現在使用している製品リストで
名前の定義をしようとすると重複してしまうのでしょうか？
縦列か横列の先頭にA社と入れ、その下もしくは横にA社の製品名を入れる。
このような表を作らなければ対応できないのでしょうか？

②色に関しては、製品名を定義し色を選ぶことで対応できました。
しかし製品の数が膨大なので範囲指定を使用すると、製品名と色の間に価格があり
製品名を色の関連付けが上手くいきません。選択範囲をどのように選べばよいのでしょうか？

③製品リストに追加された場合に自動的にドロップダウンリストに反映　させるにはどうすれば
よいでしょうか？

④製品名に - （ハイフン）が使われていると名前の定義をした場合、_（アンダーライン）になってしまいます。
結果名前が違うのでドロップダウンリストが表示されません。

質問ばかり申し訳ありませんがご教授お願い致します。

(FA)

 たぶんマクロで制御しないと全てを満足は出来ないと思いますが
 製品リストと受注表は別ファイルなのですか？
 別ファイルだとすると受注表を変更する時は製品リストは必ず開いていますか？

 ブック名や保存先、シート名などが掲示できますか？
 （ｍｏｍｏ）

ｍｏｍｏ様

先日はありがとうございました。
またお力をお借りすることになりました。宜しくお願い致します。

＞製品リストと受注表は別ファイルなのですか？

製品リストと受注表は別となっております。

＞別ファイルだとすると受注表を変更する時は製品リストは必ず開いていますか？

今は作りこんでいる状態で、まだ受注ファイル、製品ファイルともに別々に入力し、
リンクしていない状態です。

ご検討お願い致します。

(FA)

 該当するシートのオブジェクトモジュールに

  Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
  Select Case Target.Column
    Case 4: GetList Target, 1
    Case 7: GetList Target, 2
    Case 9: GetList Target, 3
    Case Else: Exit Sub
  End Select
  End Sub

  Private Sub GetList(myRng As Range, ptn As Long)
  Dim wb As Workbook, tbl As Variant, myKey As Variant, i As Long
  Const myFile As String = "製品リスト.xls"  '製品リストのブック名
  Const myPath As String = "D:\test\"        '製品リストの保存パス
  Const mySheet As String = "Sheet1"         '製品リストのシート名
  On Error Resume Next
  Set wb = Workbooks(myFile)
  On Error GoTo 0
  If wb Is Nothing Then
    Set wb = Workbooks.Open(myPath & myFile)
    ThisWorkbook.Activate
  End If
  tbl = wb.Worksheets(mySheet).Range("A1").CurrentRegion.Value
  With CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(tbl)
      Select Case ptn
        Case 1
          .Item(tbl(i, 1)) = ""
        Case 2
          If tbl(i, 1) = myRng.Offset(, -3).Value Then
            .Item(tbl(i, 4)) = ""
          End If
        Case 3
          If tbl(i, 1) = myRng.Offset(, -5).Value And _
             tbl(i, 4) = myRng.Offset(, -2).Value Then
            .Item(tbl(i, 6)) = ""
          End If
      End Select
    Next i
    myKey = .Keys
  End With
  If UBound(myKey) > 0 Then
    With myRng.Validation
      .Delete
      .Add Type:=xlValidateList, Formula1:=Join(myKey, ",")
    End With
  End If
  End Sub

 で、回答がありませんでしたがブック名や保存先、シート名を設定しなおして
 試してください。

 別ブックですので初回に起動していない場合は多少時間がかかります。

 （ｍｏｍｏ）

ｍｏｍｏ様

早速のご対応ありがとうございます。
またご質問があります。ご教授願います。

①製品番号も対応させるには、どのようにすればよいのでしょうか？

②製品名ですがカローラとパッソは表示されるのですが、それ以外が表示されません。

会社名とも連動されていないようです。

③色はリストが出てきません。何故でしょう？

コードを自分で色々と触ってみたのですがさっぱり動きません。

宜しくお願い致します。

(FA)

 とりあえず１番はおいといて、２番と３番が動く事を確認しましょう。

 シートのレイアウトは上の質問のとおりになっていますか？
 特に列のレイアウト、そして１行目はタイトル行であること。

 リストが出るのはＤ列、Ｇ列、Ｉ列です。

 合っていますか？

 土日はレスが遅くなりますが、ご容赦を。
 （ｍｏｍｏ）

ｍｏｍｏ様

深夜までご対応ありがとうございます。

レイアウトは何度も確認しましたが同じです。

列のレイアウトもタイトル行も同じでした。

リストが出るのはＤ列、Ｇ列です。Ｉ列のみ出ません。

特に急ぎというわけでもないので、ご返答は月曜日でも構いません。

ｍｏｍｏ様の方ではちゃんと動いているので、やはり私の方に問題があるのは

明確ですので、土日にもう少し自分で検討致します。

宜しくお願い致します。

(FA)

ｍｏｍｏ様

レイアウトなど見直しましたが、やはり上手くいきませんでした。

色々試してみましたが原因が掴めません。

(FA)

 おはようございます。
 土日は結局無理ですみません。
 たぶん出てこないのは該当選択肢が１つの場合ですよね

  If UBound(myKey) > 0 Then
    With myRng.Validation
      .Delete
      .Add Type:=xlValidateList, Formula1:=Join(myKey, ",")
    End With
  End If

 ここのIfの部分でKeyが１つしか無い場合にはじかれていました。
 Base0なのを忘れる初歩的ミスですみません。

 上の部分を

  With myRng.Validation
    .Delete
    Select Case UBound(myKey)
      Case Is > 0: .Add Type:=xlValidateList, Formula1:=Join(myKey, ",")
      Case 0:      .Add Type:=xlValidateList, Formula1:=myKey(0)
    End Select
  End With

 に変更してみてください。
 （ｍｏｍｏ）

 上で動作が確認できたら、製品番号を対応させるために
 全体を以下のようにしてみてください。

  Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
  Select Case Target.Column
    Case 4: GetList Target, 1
    Case 5: GetList Target, 2
    Case 7: GetList Target, 3
    Case 9: GetList Target, 4
    Case Else: Exit Sub
  End Select
  End Sub

  Private Sub GetList(myRng As Range, ptn As Long)
  Dim wb As Workbook, tbl As Variant, myKey As Variant, i As Long
  Const myFile As String = "製品リスト.xls"  '製品リストのブック名
  Const myPath As String = "D:\test\"        '製品リストの保存パス
  Const mySheet As String = "Sheet1"         '製品リストのシート名
  On Error Resume Next
  Set wb = Workbooks(myFile)
  On Error GoTo 0
  If wb Is Nothing Then
    Set wb = Workbooks.Open(myPath & myFile)
    ThisWorkbook.Activate
  End If
  tbl = wb.Worksheets(mySheet).Range("A1").CurrentRegion.Value
  With CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(tbl)
      Select Case ptn
        Case 1
          .Item(tbl(i, 1)) = ""
        Case 2
          If tbl(i, 1) = myRng.Offset(, -1).Value Then
            .Item(tbl(i, 2)) = ""
          End If
        Case 3
          If tbl(i, 1) = myRng.Offset(, -3).Value And _
             tbl(i, 2) = myRng.Offset(, -2).Value Then
            .Item(tbl(i, 4)) = ""
          End If
        Case 4
          If tbl(i, 1) = myRng.Offset(, -5).Value And _
             tbl(i, 2) = myRng.Offset(, -4).Value And _
             tbl(i, 4) = myRng.Offset(, -2).Value Then
            .Item(tbl(i, 6)) = ""
          End If
      End Select
    Next i
    myKey = .Keys
  End With
  With myRng.Validation
    .Delete
    Select Case UBound(myKey)
      Case Is > 0: .Add Type:=xlValidateList, Formula1:=Join(myKey, ",")
      Case 0:      .Add Type:=xlValidateList, Formula1:=myKey(0)
    End Select
  End With
  End Sub

 （ｍｏｍｏ）

ｍｏｍｏ様

上手くいきました！毎度毎度ありがとうございます。

やはり今、私がやろうとしていることはマクロ必須なようですね。

まだまだ課題が多くまた質問させて頂くこともあると思いますが、
またご教授お願い致します。

重ねてお礼申し上げます。

(FA)

 厳密に言うとちゃんと作りこめば作業用のシートに重複なしのリストを関数で作る事で
 関数と名前と入力規則だけでも可能だと思います。

 ただ、別ブックである事やリストの範囲がどこまで増えるかわからない事を
 考慮すると私ならVBAでやってしまうというだけです。

 私はその辺の面倒な事を関数でやる根気が無いので・・・^^;

 （ｍｏｍｏ）

ｍｏｍｏ様

当初は関数でと思っていたのですが、関数でも行き詰まってました。

ＶＢＡ組めると仕事が捗るでしょうね。

今後はｍｏｍｏ様にご教授頂いたＶＢＡを改造して少しずつ覚えたいと思います。

私の場合、改造前にコード解析（理解）からですが（笑）

今回も本当にありがとうございました。

ご好意に甘えてばかり申し訳ありません。

(FA)

コメント返信：

[ 一覧(最新更新順) ]

[[20101104215614]] 『ドロップダウンリスト』（FA） ページの最後に飛ぶ

[[20101104215614]]　『ドロップダウンリスト』（FA）　ページの最後に飛ぶ