[[20140618102217]]　『複数コンボボックスの連携について』（hide）　ページの最後に飛ぶ

『複数コンボボックスの連携について』（hide）

複数コンボボックスの連携について過去回答欄にて下記のコードを見つけ
是非活用させて頂こうとしましたが、知識的に不足している為、理解出来ません。

5個のコンボボックスを連携させてあり、シートのA列からE列までの連携です。
これをC列からG列に変更したいのですが、難しくて解析出来ない為どうなっているのか
理解できません。変更して頂ければ照らし合わせて勉強できるので宜しくお願いします。

本当に作った方凄いと感じました。

Private myComb As New Collection

  Private myRng As Range

  Private Sub UserForm_Initialize()
  Dim i As Long, tbl As Variant
  For i = 1 To 5
    myComb.Add Me.Controls("ComboBox" & i)
  Next i
  With Worksheets("Sheet1").Range("A1").CurrentRegion
    Set myRng = .Offset(1).Resize(.Rows.Count - 1)
  End With
  With CreateObject("Scripting.Dictionary")
    tbl = myRng.Resize(, 1).Value
    For i = 1 To UBound(tbl)
      If Not .Exists(tbl(i, 1)) Then
        .Add tbl(i, 1), ""
      End If
    Next i
    Me.ComboBox1.List = .keys
  End With
  End Sub

  Private Sub ComboBox1_Change()
  SetList 1
  End Sub

  Private Sub ComboBox2_Change()
  SetList 2
  End Sub

  Private Sub ComboBox3_Change()
  SetList 3
  End Sub

  Private Sub ComboBox4_Change()
  SetList 4
  End Sub

  Private Sub ComboBox5_Change()
  SetList 5 '必要無いけど・・・
  End Sub

  Private Sub SetList(CntNum As Long)
  Dim tbl1 As Variant, tbl2 As Variant, i As Long, myKey As String
  If CntNum >= myComb.Count Then Exit Sub
  For i = CntNum + 1 To myComb.Count
    myComb(i).Clear
  Next i
  tbl1 = myRng.Resize(, CntNum).Value
  tbl2 = myRng.Offset(, CntNum).Resize(, 1).Value
  For i = 1 To CntNum
    myKey = myKey & vbTab & myComb(i).Value
  Next i
  With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(tbl1)
      If Join(Application.WorksheetFunction.Index(tbl1, i, 0), vbTab) = Mid(myKey, 2) Then
        If Not .Exists(tbl2(i, 1)) Then
          .Add tbl2(i, 1), ""
        End If
      End If
    Next i
    myComb(CntNum + 1).List = .keys
  End With
  End Sub

＜使用 Excel：Excel2007、使用 OS：Windows7 ＞

 参考になるかな？
[[20131105121455]]　『Comboboxリスト抽出』（KISS）

（seiya） 2014/06/18(水) 11:36

 おじゃまします。
 かぶってましたら、すみません m(_ _)m

 '★ 事前に Microsoft Scripting Runtimeへの参照設定が必要です
'-----------------------------------------------------------
 Option Explicit
 Private dic As Scripting.Dictionary
 Dim a, b, c, d, e

 Private Sub UserForm_Initialize()
    Dim v, i&
    With Worksheets("Sheet1")
        v = .Range("C2", .Cells(.Rows.Count, "C").End(xlUp) _
            ).Resize(, 5).Value  'C列からG列までを配列に
    End With
    Set dic = New Dictionary
    For i = 1 To UBound(v)
        a = v(i, 1)
        b = v(i, 2)
        c = v(i, 3)
        d = v(i, 4)
        e = v(i, 5)
        If Not dic.Exists(a) Then Set dic(a) = New Dictionary
        If Not dic(a).Exists(b) Then Set dic(a)(b) = New Dictionary
        If Not dic(a)(b).Exists(c) Then Set dic(a)(b)(c) = New Dictionary
        If Not dic(a)(b)(c).Exists(d) Then Set dic(a)(b)(c)(d) = New Dictionary
        If Not dic(a)(b)(c)(d).Exists(e) Then Set dic(a)(b)(c)(d)(e) = New Dictionary
    Next
    ComboBox1.List = dic.Keys()
 End Sub

 Private Sub ComboBox1_Change()
    a = ComboBox1.Value
    ComboBox2.List = dic(a).Keys()
    ComboBox3.ListIndex = -1
    ComboBox4.ListIndex = -1
    ComboBox5.ListIndex = -1
 End Sub
 Private Sub ComboBox2_Change()
    b = ComboBox2.Value
    ComboBox3.List = dic(a)(b).Keys()
    ComboBox3.ListIndex = -1
    ComboBox4.ListIndex = -1
    ComboBox5.ListIndex = -1
 End Sub
 Private Sub ComboBox3_Change()
    c = ComboBox3.Value
    If Len(c) Then ComboBox4.List = dic(a)(b)(c).Keys()
    ComboBox4.ListIndex = -1
    ComboBox5.ListIndex = -1
 End Sub
 Private Sub ComboBox4_Change()
    d = ComboBox4.Value
    If Len(d) Then ComboBox5.List = dic(a)(b)(c)(d).Keys()
    ComboBox5.ListIndex = -1
 End Sub

（kanabun） 2014/06/18(水) 12:45

 「参照設定」は、VBEの「ツール」メニューにあります。
http://www.tipsfound.com/VBA/01005.vbhtml
（kanabun） 2014/06/18(水) 21:44

seiyaさん参考ありがとうございます。
ちょこちょこと変更しながら考えてますが、
パンク中で時間が掛かりそうです。

kanabunさん提案ありがとうございます。
勉強の為に質問のコードで何処をどう変えれば
C列からG列に変更出来るのかな？と悩んでいます。
今後教えていただいたコードは是非活用させて頂こうと思います。
（hide） 2014/06/19(木) 08:51

 こんにちは～

 > 質問のコードで何処をどう変えれば 
 > C列からG列に変更出来るのかな？と悩んでいます。

 ぼくも最初に引用されたコレクションを使ったコードは 解読し切れてません。

 > Private Sub SetList()
 このプロシージャで毎回シートからリストを組み立ててるようですね？

 >  With Worksheets("Sheet1").Range("A1").CurrentRegion
 >    Set myRng = .Offset(1).Resize(.Rows.Count - 1)
 >  End With
 ここで、表範囲を（1行目はカットして）取得しているようです。

 ぼくの書いたのでは
 >   With Worksheets("Sheet1")
 >       v = .Range("C2", .Cells(.Rows.Count, "C").End(xlUp) _
 >           ).Resize(, 5).Value  'C列からG列までを配列に
 >   End With
 で、C～G列 範囲を取得して 範囲の値を配列に放り込んでいます。
（kanabun） 2014/06/19(木) 12:19

コメント返信：

[ 一覧(最新更新順) ]

[[20140618102217]] 『複数コンボボックスの連携について』（hide） ページの最後に飛ぶ

[[20140618102217]]　『複数コンボボックスの連携について』（hide）　ページの最後に飛ぶ