[[20180912223210]]　『VBAコンボボックスの連動』（みみ）　ページの最後に飛ぶ

『VBAコンボボックスの連動』（みみ）

VBA初心者です。
連動がうまくいかず悩んでいます。

フォームにコンボボックスを3つ配置して、連動し表示、
またコンボボックスの結果をもとに
テキストボックスにも内容を反映させたいです。

コンボボックスには重複した値をなくしたいです。

コンボボックス1…品名
コンボボックス2…型
コンボボックス3…メーカー　
テキストボックス1…単価　　型から単価を導きたいです
テキストボックス2…会社　メーカーから会社を導きたいです

   A   B    C      D         E    F       G
1　ID  No.　品名　メーカー　型　  単価　 会社
2
3
4
5
：
400

よろしくお願いします。

＜使用 Excel：Excel2013、使用 OS：Windows8 ＞

 どこがうまくいかなくて困っているんですか？
 コードはありませんか？

 サンプルデータが全くの空欄なので
 やりたいことがいまいちわかりません。

 連動ってことはコンボボックス1の選択内容によって
 コンボボックス2のリストをかえたいとか、そういうことですか？
（TAKA） 2018/09/13(木) 09:05

 ユーザーフォーム上に
 ComboBox x 3 (ComboBox1, ComboBox2, ComboBox3)
 TextBox x 2 (TextBox1, TextBox2)
 を配置

 Option Explicit

 Private dic As Object

 Private Sub UserForm_Initialize()
     Dim a, i As Long
     Set dic = CreateObject("Scripting.Dictionary")
     dic.CompareMode = 1
     a = Sheets("sheet1").Cells(1).CurrentRegion.Value
     For i = 2 To UBound(a, 1)
         a(i, 2) = CStr(a(i, 2))
         If Not dic.exists(a(i, 2)) Then
             Set dic(a(i, 2)) = CreateObject("Scripting.Dictionary")
             dic(a(i, 2)).CompareMode = 1
         End If
         a(i, 4) = CStr(a(i, 4))
         If Not dic(a(i, 2)).exists(a(i, 4)) Then
             Set dic(a(i, 2))(a(i, 4)) = CreateObject("Scripting.Dictionary")
             dic(a(i, 2))(a(i, 4)).CompareMode = 1
         End If
         a(i, 3) = CStr(a(i, 3))
         dic(a(i, 2))(a(i, 4))(a(i, 3)) = Array(a(i, 5), a(i, 6))
     Next
     Me.ComboBox1.List = dic.keys
 End Sub

 Private Sub ComboBox1_Change()
     With Me
         .ComboBox2.Clear: .ComboBox3.Clear
         ClearTB
         If .ComboBox1.ListIndex = -1 Then Exit Sub
         .ComboBox2.List = dic(Me.ComboBox1.Value).keys
     End With
 End Sub

 Private Sub ComboBox2_Change()
     Me.ComboBox3.Clear
     ClearTB
     If Me.ComboBox2.ListIndex = -1 Then Exit Sub
     Me.ComboBox3.List = dic(Me.ComboBox1.Value)(Me.ComboBox2.Value).keys
 End Sub

 Private Sub ComboBox3_Change()
     ClearTB
     If Me.ComboBox3.ListIndex = -1 Then Exit Sub
     With Me
         .TextBox1.Value = dic(.ComboBox1.Value)(.ComboBox2.Value)(.ComboBox3.Value)(0)
         .TextBox2.Value = dic(.ComboBox1.Value)(.ComboBox2.Value)(.ComboBox3.Value)(1)
     End With
 End Sub

 Private Sub ClearTB()
     Me.TextBox1.Value = ""
     Me.TextBox2.Value = ""
 End Sub

（seiya） 2018/09/13(木) 10:19

TAKAさん、コメント有難うございます。
説明不足ですみません。
察して頂いてる通り、コンボボックス1で品名を選んだら
コンボボックス2で型を絞り込み、コンボボックス3でメーカーを表示させたかったんです。

seiyaさんのプログラムを参考に作ってみます。
有難うございました。
（みみ） 2018/09/13(木) 20:26

seiyaさん、コメント有難うございます。
説明不足にもかかわらず、やりたいことを読み取っていただき感激です。
作って下さったプログラムを少し変えて動かしてみたところ
ばっちり求めていた動作になりました。

一つ教えてほしい所がありまして
少し変更したプログラムがこれなんですが

Private Sub UserForm_Initialize()

     Dim a, i As Long
     Set dic = CreateObject("Scripting.Dictionary")
     dic.CompareMode = 1
     a = Sheets("sheet1").Cells(1).CurrentRegion.Value
     For i = 3 To UBound(a, 1)
         a(i, 3) = CStr(a(i, 3))
         If Not dic.exists(a(i, 3)) Then
             Set dic(a(i, 3)) = CreateObject("Scripting.Dictionary")
             dic(a(i, 3)).CompareMode = 1
         End If
         a(i, 5) = CStr(a(i, 5))
         If Not dic(a(i, 3)).exists(a(i, 5)) Then
             Set dic(a(i, 3))(a(i, 5)) = CreateObject("Scripting.Dictionary")
             dic(a(i, 3))(a(i, 5)).CompareMode = 1
         End If
         a(i, 3) = CStr(a(i, 3))
         dic(a(i, 3))(a(i, 5))(a(i, 4)) = Array(a(i, 6), a(i, 7))
     Next
     Me.ComboBox1.List = dic.keys

 End Sub

 Private Sub ComboBox1_Change()
     With Me
         .ComboBox2.Clear: .ComboBox3.Clear
         ClearTB
         If .ComboBox1.ListIndex = -1 Then Exit Sub
         .ComboBox2.List = dic(Me.ComboBox1.Value).keys
     End With
 End Sub

 Private Sub ComboBox2_Change()
     Me.ComboBox3.Clear
     ClearTB
     If Me.ComboBox2.ListIndex = -1 Then Exit Sub
     Me.ComboBox3.List = dic(Me.ComboBox1.Value)(Me.ComboBox2.Value).keys
 End Sub

 Private Sub ComboBox3_Change()
     ClearTB
     If Me.ComboBox3.ListIndex = -1 Then Exit Sub
     With Me
         .TextBox1.Value = dic(.ComboBox1.Value)(.ComboBox2.Value)(.ComboBox3.Value)(0)
         .TextBox2.Value = dic(.ComboBox1.Value)(.ComboBox2.Value)(.ComboBox3.Value)(1)
     End With
 End Sub

 Private Sub ClearTB()
     Me.TextBox1.Value = ""
     Me.TextBox2.Value = ""
 End Sub

コンボボックス1の品名のリストを下までスクロールしたら
少し空白の行があってその下に品名と言うリストが入るようになってしまいました。

何処が原因なのでしょうか・・・。
（みみ） 2018/09/13(木) 20:35

 >少し空白の行があってその下に品名と言うリストが入るようになってしまいました。
 範囲内に空白があるのでしょうか？

 UserForm_Initialize を下記に差し替えてみてください。

 Private Sub UserForm_Initialize()
     Dim a, i As Long
     Set dic = CreateObject("Scripting.Dictionary")
     dic.CompareMode = 1
     a = Sheets("sheet1").Cells(1).CurrentRegion.Value
     For i = 3 To UBound(a, 1)
         If a(i, 3) <> "" Then
            a(i, 3) = CStr(a(i, 3))
            If Not dic.exists(a(i, 3)) Then
                Set dic(a(i, 3)) = CreateObject("Scripting.Dictionary")
                dic(a(i, 3)).CompareMode = 1
            End If
            a(i, 5) = CStr(a(i, 5))
            If Not dic(a(i, 3)).exists(a(i, 5)) Then
                Set dic(a(i, 3))(a(i, 5)) = CreateObject("Scripting.Dictionary")
                dic(a(i, 3))(a(i, 5)).CompareMode = 1
            End If
            a(i, 3) = CStr(a(i, 3))
            dic(a(i, 3))(a(i, 5))(a(i, 4)) = Array(a(i, 6), a(i, 7))
        End If
     Next
     Me.ComboBox1.List = dic.keys
 End Sub
（seiya） 2018/09/13(木) 23:44

新しく作って下さったプログラムに変更したら
範囲内にあった空白がなくなりました！！
seiyaさん、ありがとうございました！！

（みみ） 2018/09/14(金) 21:41

コメント返信：

[ 一覧(最新更新順) ]

[[20180912223210]] 『VBAコンボボックスの連動』（みみ） ページの最後に飛ぶ

[[20180912223210]]　『VBAコンボボックスの連動』（みみ）　ページの最後に飛ぶ