[[20090924220534]] 『同一フォーム上に2組の連携するコンボボックスを』(SJC) >>BOT

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『同一フォーム上に2組の連携するコンボボックスを作成』(SJC)

 先程
[[20090923194642]] 『コンボボックスの連携&重複削除』(SJC)
で教えて頂いた続き(?)なのですが
 新しく質問させて頂きます。

 先程ご教授頂き、現在ユーザーフォーム上のコンボボックス1〜4まで連携させた状態でいます。
 コードは以下の通りです(教えて頂いたものをコピペした状態です・・・)。

 '=====================================================================================
 'ComboBox1(分類)に「製品リスト」シートA列の選択肢を表示
 'ComboBox2(品種名)にComboBox1で選択した「分類」に対応する「品種名」の選択肢を表示(重複は削除)
 'ComboBox3(品目名)にComboBox2で選択した「品種名」に対応する「品目名」の選択肢を表示(重複は削除)
 'ComboBOx4(入れ目)にComboBox3で選択した「品目名」に対応する「入れ目」の選択肢を表示(重複は削除)
 'Microsoft Scripting Runtime への参照設定が必要
 '  [ツール] メニューの [参照設定] をクリックし、
 '  [Microsoft Scripting Runtime] チェック ボックスをオンにする
 '=====================================================================================

 Option Explicit

  Private dic() As Scripting.Dictionary
  Private dicMax As Long
  Private Const BOXCOUNT = 4  '◆ComboBoxの数

  Private Sub UserForm_Initialize()
     Dim v, sKey As String
     Dim i As Long, j As Long, k As Long, n As Long

     With Worksheets("製品リスト")
         v = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)). _
               Resize(, BOXCOUNT).Value
     End With

     dicMax = UBound(v) * BOXCOUNT '程度
     ReDim dic(1 To dicMax)
     Set dic(1) = New Scripting.Dictionary
     k = 1
     For i = 1 To UBound(v)
         n = 1
         For j = 1 To BOXCOUNT - 1
             If Not IsEmpty(v(i, j)) Then sKey = v(i, j)
             If Not dic(n).Exists(sKey) Then
                 k = k + 1
                 dic(n)(sKey) = k       '★下位のComboBox用dic番号
                 Set dic(k) = New Scripting.Dictionary
                 n = k
             Else
                 n = dic(n)(sKey)
             End If
         Next
         dic(n).Item(v(i, j)) = Empty
     Next
     dicMax = k
     With ComboBox1
         .List = Application.Transpose(Array(dic(1).Keys, dic(1).Items))
     End With
  End Sub

  Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
     Dim i As Long
     For i = dicMax To 1 Step -1
         Set dic(i) = Nothing
     Next
  End Sub

  Private Sub ComboBox1_Change()
     ComboBox_Update ComboBox1, ComboBox2
  End Sub

  Private Sub ComboBox2_Change()
     ComboBox_Update ComboBox2, ComboBox3
  End Sub

  Private Sub ComboBox3_Change()
     ComboBox_Update ComboBox3, ComboBox4
  End Sub

  Private Sub ComboBox_Update(ByVal Combo1 As MSForms.ComboBox, _
                              ByVal Combo2 As MSForms.ComboBox)
     Dim idx As Long
     Dim n As Long, i As Long
     Dim v
     idx = Combo1.ListIndex
     If idx < 0 Then Exit Sub
     n = Combo1.List(idx, 1)
     With Combo2
         i = 0
         .Clear
         For Each v In dic(n).Keys
             .AddItem v
             .List(i, 1) = dic(n).Item(v)
             i = i + 1
         Next

     End With

  End Sub

 続いて、同じユーザーフォーム上のコンボボックス5〜8とテキストボックス1を連携させたいのですが、うまくいきません。
 やりたい内容としては、

 ComboBox5(添付情報)に「様式リスト」シートA列の選択肢を表示(重複削除)
 ComboBox6(分類)にComboBox5で選択した「添付情報」に対応する「分類」の選択肢を「様式リスト」シートB列から表示(重複削除)
 ComboBox7(品目名)にComboBox6で選択した「分類」に対応する「品目名」の選択肢を「様式リスト」シートC列から表示(重複削除)
 ComboBox8(扱い先)にComboBox7で選択した「品目名」に対応する「扱い先」の選択肢を「様式リスト」シートD列から表示(重複削除)
 TextBox1(CP情報)にComboBox7で選択した「品目名」に対応する「CP情報」を「様式リスト」シートH列から表示

 です。

 教えて頂いたコードのボックス名を変更(例えばComboBox1→COmboBox5)すればできるはずだと安易に考えたのがいけないのですが・・・。

 また、現在作成しているユーザーフォーム1が完成したら
 全く同じ形のユーザーフォーム2・3も作成(コピー)し、
 各コンボボックスやテキストボックスの値を別シートのセルに転記したいと考えているのですが
 やはり不具合が出てしまうものでしょうか・・・。

 コードをきちんと理解していない故の 浅はかな質問だとは思うのですが
 初心者な上に締切間近で軽くパニック状態だからと
 寛大なお心でご教授頂ければ幸です。
 どうぞ宜しくお願い致します。


 こんばんは。
 > 教えて頂いたコードのボックス名を変更(例えばComboBox1→COmboBox5)すればできるはずだと安易に考えたのがいけないのですが・・・。

 前の「製品リスト」表と今回の「情報リスト」表とは 独立しているんですよね?
 でしたら、
  Dictionaryオブジェクトの第2のシリーズを追加して(いい名前が思いつかないので、dib とします)
  コードは dicをセットするためにやっていることをそっくりコピーすればいい。
  幸い、今度もComboBoxの数は4段階だし。。。
  前とちがうのは ComboBox4 までで終わりだったが、こんどは (4番目の)ComboBox8の選択項目に対応
  した(H列の)値をTextBoxに表示する、という点。

 Option Explicit

 Private dic() As Scripting.Dictionary '第1グループ用
 Private dicMax As Long                '第1グループ用
 Private Const BOXCOUNT = 4            '第1グループ用◆ComboBoxの数

 Private dib() As Scripting.Dictionary '第2グループ用
 Private dibMax As Long                '第2グループ用

 Private Sub UserForm_Initialize()
    Dim v, sKey As String
    Dim i As Long, colm As Long, k As Long, n As Long

    With Worksheets("製品リスト")                            '------- 第1グループのTree 作成
        v = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)). _
              Resize(, BOXCOUNT).Value
    End With

    dicMax = UBound(v) * BOXCOUNT '程度
    ReDim dic(1 To dicMax)
    Set dic(1) = New Scripting.Dictionary
    k = 1
    For i = 1 To UBound(v)
        n = 1
        For colm = 1 To BOXCOUNT - 1
            If Not IsEmpty(v(i, colm)) Then sKey = v(i, colm)
            If Not dic(n).Exists(sKey) Then
                k = k + 1
                dic(n)(sKey) = k       '★下位のComboBox用dic番号
                Set dic(k) = New Scripting.Dictionary
                n = k
            Else
                n = dic(n)(sKey)
            End If
        Next
        dic(n).Item(v(i, colm)) = Empty
    Next
    dicMax = k
    With ComboBox1                                        '先頭レベルComboBox1の リストをセットする
        .List = Application.Transpose(Array(dic(1).Keys, dic(1).Items))
        .ListIndex = 0
    End With

  ' 続いて、ComboBox5〜ComboBox8とTextBox1                   '------- 第2グループのTree 作成
  '
    With Worksheets("様式リスト")
        v = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)). _
              Resize(, 8).Value       'H列まで
    End With

    dibMax = UBound(v) * BOXCOUNT '程度
    ReDim dib(1 To dibMax)
    Set dib(1) = New Scripting.Dictionary
    k = 1
    For i = 1 To UBound(v)
        n = 1
        For colm = 1 To BOXCOUNT - 1
            If Not IsEmpty(v(i, colm)) Then sKey = v(i, colm)
            If Not dib(n).Exists(sKey) Then
                k = k + 1
               dib(n)(sKey) = k       '★下位のComboBox用dic番号
                Set dib(k) = New Scripting.Dictionary
                n = k
            Else
                n = dib(n)(sKey)
            End If
        Next
       dib(n).Item(v(i, colm)) = v(i, 8)             '---- 最後のComboBox8 には H列の値を連動させる
    Next
    dibMax = k
    With ComboBox5                                   '先頭のComboBox5 に リスト dib(1) をセット
        .List = Application.Transpose(Array(dib(1).Keys, dib(1).Items))
        .ListIndex = 0
    End With

 End Sub

 Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Dim i As Long
    For i = dicMax To 1 Step -1
        Set dic(i) = Nothing
    Next
    For i = dibMax To 1 Step -1
        Set dib(i) = Nothing
    Next

 End Sub

 Private Sub ComboBox1_Change()
    ComboBox_Update ComboBox1, ComboBox2, dic()   '第3引数に 使用dictionaryオブジェクト名を入れる
 End Sub

 Private Sub ComboBox2_Change()
    ComboBox_Update ComboBox2, ComboBox3, dic()
 End Sub

 Private Sub ComboBox3_Change()
    ComboBox_Update ComboBox3, ComboBox4, dic()
 End Sub

 Private Sub ComboBox5_Change()
    ComboBox_Update ComboBox5, ComboBox6, dib()    '第3引数に 使用dictionaryオブジェクト名を入れる
 End Sub

 Private Sub ComboBox6_Change()
    ComboBox_Update ComboBox6, ComboBox7, dib()
 End Sub

 Private Sub ComboBox7_Change()
    ComboBox_Update ComboBox7, ComboBox8, dib()
 End Sub

 Private Sub ComboBox_Update(ByVal Combo1 As MSForms.ComboBox, _
                             ByVal Combo2 As MSForms.ComboBox, _
                             dictio() As Dictionary)   '第3引数に 使用dictionaryオブジェクト名を入れる
    Dim idx As Long
    Dim n As Long, i As Long
    Dim v
    idx = Combo1.ListIndex
    If idx < 0 Then Exit Sub
    n = Combo1.List(idx, 1)
    With Combo2
        i = 0
        .Clear
        For Each v In dictio(n).Keys
            .AddItem v
            .List(i, 1) = dictio(n).Item(v)
            i = i + 1
        Next
        .ListIndex = 0
    End With
 End Sub

 Private Sub ComboBox8_Change()
    Dim ss As String
    Dim idx As Long
    With ComboBox8
        idx = .ListIndex
        If idx < 0 Then Exit Sub
        TextBox1.Text = .List(idx, 1)
    End With
 End Sub

  (kanabun) 2009-09-25 00:25


 (kanabun)様

 何度も丁寧に 本当に有り難う御座います。
 おかげさまでうまく動きました。
 御礼が遅くなり申し訳ありませんでした。

 仰るとおり
 >前の「製品リスト」表と今回の「情報リスト」表とは 独立して    います。
 説明不足で申し訳ありませんでした。

 重ね重ね恐縮ですが、
 >こんどは (4番目の)ComboBox8の選択項目に対応した(H列の)値をTextBoxに表示する     に付け加えて
 ComboBox8の選択項目に対応した(E列の)値を別シート(「依頼書」シート、セルB12)に
 ComboBox8の選択項目に対応した(F列の)値を別シート(「依頼書」シート、セルE12)に表示するにはどのようにすればよいでしょうか。
 (「情報リスト」シートの絞り込みはComboBox8が最終です。
  ComboBox8で選択するとE,F,Hの各列には重複するデータはありません)

 >dib(n).Item(v(i, colm)) = v(i, 8) 

 >With ComboBox8
         idx = .ListIndex
         If idx < 0 Then Exit Sub
         TextBox1.Text = .List(idx, 1)
     End With

 の辺りを変更・追加すれば出来ると思い、色々と試してみたのですがうまくいきません。

 度々 本当に申し訳ありませんが何卒宜しくお願い致します。  (SJC)

 > >dib(n).Item(v(i, colm)) = v(i, 8) 
 > 
 > >With ComboBox8
 >         idx = .ListIndex
 >         If idx < 0 Then Exit Sub
 >         TextBox1.Text = .List(idx, 1)
 >     End With
 >
 > の辺りを変更・追加すれば出来ると思い、

 おっしゃるとおりです(^^
 Dictionary (オブジェクト名 dib() )のアイテムには それがどこのセルからもってきたデータか?
 という情報はありませんから、
 >dib(n).Item(v(i, colm)) = v(i, 8) 
  の代わりに、3つのセルの値を TABか何かで結合して アイテムに代入しておくわけです。

  → dib(n).Item(v(i, colm)) = v(i, 8) & vbTab & v(i,5) & vbTab & v(i,6)

  で、ComboBox8_Click() イベントプロシージャで

     Dim v as variant '変数追加
     With ComboBox8
         idx = .ListIndex
         If idx < 0 Then Exit Sub
         v = Split(.List(idx, 1), vbTab)  'TABで結合された文字列を 3つにわける
         TextBox1.Text = v(0)
         別シートのセル1.Value = v(1) 
         別シートのセル2.Value = v(2) 
     End With

   のようなコードを書けば、可能かと思います。
   もうちょっとですから、再度トライしてみてください。

    (kanabun)  2009-09-26 0:37


 (kanabun)様

 本当に何度もありがとうございました。
 おかげさまでうまく動きました。

 結合してから分ける という処理が必要なのですね。
 思いもよりませんでした。

 これからじっくり勉強したいと思います。
 ありがとうございました。
 (SJC)

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.