[[20091006155736]] 『コンボボックスについて』(ミー) >>BOT

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

 

『コンボボックスについて』(ミー)

 ユーザーフォームのコンボボックスにリスト表示させたいのですが、sheets("リスト")の
A1からC240までのリストがあって、A列社名、B列氏名、C列IDとなっています。
Combobox1で社名を選んだらCombobox2に氏名をリスト表示させたいのですが・・・
  
Private Sub ComboBox2_DropButtonClick()
Dim ws1 As Worksheet
Dim 社名 As String
Dim i As Integer
Dim c As Range
Set ws1 = Sheets("リスト")
  
業者 = Me.ComboBox1.Value
For i = 1 To 240
    Set c = ws1.Range(ws1.Cells(1, 1), ws1.Cells(i, 1)).Find(what:=社名, LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows)

       If Not c Is Nothing Then
          Me.ComboBox11.AddItem c.Offset(, 1)
       End If
      
Next i
End Sub
  
としたのですが、最初に検索されたc.offset(,1)の○○さんが社名の数だけコンボボックスのリストに出てきます。
何がいけないのでしょう?
根本的に駄目なのかと思いますが、なにぶん素人なもので・・・
宜しくお願いします。

 IDはどうするの?(ROUGE)
 
Private dic1 As Object
Private dic2 As Object
Private Sub UserForm_Initialize()
Dim tbl,x,i As Long
Set dic1=CreateObject("Scripting.Dictioanry")
Set dic2=CreateObject("Scripting.Dictionary")
With Sheets("リスト")
  tbl=.Range("A1",.Range("A" & Rows.Count).End(xlUp)).Resize(,3).Value
End With
For i=1 To UBound(tbl,1)
  If Not dic1.Exists(tbl(i,1)) Then
    dic1.Add tbl(i,1),Array(tbl(i,2))
  Else
    x=dic1.Item(tbl(i,1))
    ReDim Preserve x(UBound(x)+1)
    x(UBound(x))=tbl(i,2)
    dic.Item(tbl(i,1))=x
  End If
  x=tbl(i,1) & "_" & tbl(i,2)
  If Not dic2.Exists(x) Then dic2.Add x,tbl(i,3)
Next
Me.ComboBox1.List=dic1.Keys
End Sub
Private Sub ComboBox2_DropDownClick()
If Me.ComboBox1.Value="" Then
  MsgBox "社名を選択してください。"
Else
  Me.ComboBox2.List=dic1.Item(Me.ComboBox1.Value)
End If
End Sub
Private Sub ComboBox1_Change()
Me.ComboBox2.Vlaue=""
End Sub

 衝突してしまいましたが・・・

 このような場合、私がよくやる方法としてはUserForm_Initializeの段階で
 リストをDictionaryオブジェクトに入れてしまってComboBox1のリストを設定。
 そしてComboBox1_ChangeイベントでComboBox2のリストを設定してしまいます。

 以下、サンプルコードです。

  Private myDic As Object

  Private Sub UserForm_Initialize()
  Dim v, i As Long
  v = Worksheets("リスト").Range("A1").CurrentRegion.Value
  Set myDic = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(v)
    myDic.Item(v(i, 1)) = myDic.Item(v(i, 1)) & vbTab & v(i, 2)
  Next i
  Me.ComboBox1.List = myDic.keys
  End Sub

  Private Sub ComboBox1_Change()
  Me.ComboBox2.List = Split(Mid$(myDic.Item(Me.ComboBox1.Value), 2), vbTab)
  End Sub

 (momo)

momoさんにROUGEさんありがとうございます。

シンプルなmomoさんのサンプルコードを使ってみました。

質問に少し追加させていただきます。

Vに格納するリストが3列あった場合で

myDic.Item(v(i, 1)) = myDic.Item(v(i, 1)) & vbTab & v(i, 2) & vbTab & v(i, 3)

とするとcombobox1にはA列の重複しないリストが表示されますよね。

それで、combobox2にはcombobox1_changeでB列の重複しないリスト

    combobox3にはcombobox2_changeでC列の重複しないリスト


表示されるようにしたいのですが、

myDic.Item(v(i, 1)) = myDic.Item(v(i, 1)) & vbTab & v(i, 2) & vbTab & v(i, 3)
として

conbobox1_change()

Me.ComboBox2.List = Split(Mid$(myDic.Item(Me.ComboBox1.Value), 2), vbTab)

とすると、B列C列両方が表示されます。

どうしたらよいのでしょうか?


 単純にDictionaryを2つ作ってあげた方が処理としては簡単です。
 もちろんB列とC列をくっつけたものをSplitしても出来ますが
 Listに直接配列として入れられないのでループして分離するので多少面倒です。

 あと、私のコードが簡単に見えるのはエラー処理や
 ComboBox1が変更された時にComboBox2の表示をどうするか?とかを
 考慮していないためであって、ROUGEさんのはそれを考慮しているために
 長くなっているだけですので気に留めておいてください。

  Private myDic1 As Object
  Private myDic2 As Object

  Private Sub UserForm_Initialize()
  Dim v, i As Long
  v = Worksheets("リスト").Range("A1").CurrentRegion.Value
  Set myDic1 = CreateObject("Scripting.Dictionary")
  Set myDic2 = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(v)
    myDic1.Item(v(i, 1)) = myDic1.Item(v(i, 1)) & vbTab & v(i, 2)
    myDic2.Item(v(i, 2)) = myDic2.Item(v(i, 2)) & vbTab & v(i, 3)
  Next i
  Me.ComboBox1.List = myDic1.keys
  End Sub

  Private Sub ComboBox1_Change()
  Me.ComboBox2.List = Split(Mid$(myDic1.Item(Me.ComboBox1.Value), 2), vbTab)
  End Sub

  Private Sub ComboBox2_Change()
  Me.ComboBox3.List = Split(Mid$(myDic2.Item(Me.ComboBox2.Value), 2), vbTab)
  End Sub

 (momo)

momoさんありがとうございます。

すいません。私の質問の仕方が悪かったですね。はしょってしまいました。

リスト表ですが、下記のようになっています。

   A   B   C   
 1 社名  部署  氏名  
 2 ○社  ○課  ○○  
 3 ○社  △課  ××
 4 ×社  ○課  △△
 5 △社  ×課  ○△
 6 ○社  ○課  ○×
 7 ×社  ○課  ×○
 ・ ・   ・   ・
 ・ ・   ・   ・

となっていまして、combobox1にA列の重複しないリストを表示し、combobox1で選択したら、

combobox1.valueかつB列の重複しないリストが表示、combobox2で選択したら、

combobox1.valueかつcombobox2.valueかつC列の重複しないリストが表示できるようにしたいのです。

 Private Sub ComboBox1_Change()
  Me.ComboBox2.List = Split(Mid$(myDic1.Item(Me.ComboBox1.Value), 2), vbTab)
 End Sub

だと、重複データも表示されてしまいます。


 >重複データも表示されてしまいます。 
 当然、そういう仕様が当たり前ですよね。
 説明不足というより、私の読取りミスです。すみません。
 myDic2のkeyをA列とB列の合成にして、呼出にはComboBox1とComboBox2の値を合成したものを使います。
 テストせずにベタ打ちで書きましたのでバグがあったら教えてください。

  Private myDic1 As Object
  Private myDic2 As Object

  Private Sub UserForm_Initialize()
  Dim v, i As Long
  v = Worksheets("リスト").Range("A1").CurrentRegion.Value
  Set myDic1 = CreateObject("Scripting.Dictionary")
  Set myDic2 = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(v)
    myDic1.Item(v(i, 1)) = myDic1.Item(v(i, 1)) & vbTab & v(i, 2)
    myDic2.Item(v(i, 1) & vbTab & v(i, 2)) = myDic2.Item(v(i, 1) & vbTab & v(i, 2)) & vbTab & v(i, 3)
  Next i
  Me.ComboBox1.List = myDic1.keys
  End Sub

  Private Sub ComboBox1_Change()
  Me.ComboBox2.List = Split(Mid$(myDic1.Item(Me.ComboBox1.Value), 2), vbTab)
  End Sub

  Private Sub ComboBox2_Change()
  Me.ComboBox3.List = Split(Mid$(myDic2.Item(Me.ComboBox1.Value & vbTab & Me.ComboBox2.Value), 2), vbTab)
  End Sub

 (momo)

 これで試してください。

 Private dic As Object

 Private Sub UserForm_Initialize()
 Dim a, w(), i As Long, z As String, x
 a = Worksheets("リスト").Range("A1").CurrentRegion.Resize(, 3).Value
 For i = 2 To UBound(a, 1)
     If Not dic.exists(a(i, 1)) Then
         ReDim w(1 To 1) : w(1) = a(i, 2) : dic(a(i, 1)) = w
     Else
         w = dic(a(i, 1))
         x = Application.Match(a(i, 2), w, 0)
         If IsError(x) Then
             ReDim Preserve w(1 To UBound(w) + 1)
             w(UBound(w)) = a(i, 2)
             dic(a(i, 1)) = w
         End If
     End If
     z = a(i, 1) & ";" & a(i, 2)
     If Not dic.exists(z) Then
         ReDim w(1 To 1) : w(1) = a(i, 3) : dic(z) = w
     Else
         w = dic(z)
         x = Application.Match(z, w, 0)
         If IsError(x) Then
             ReDim Preserve w(1 To UBound(w) + 1)
             w(UBound(w)) = a(i, 3)
             dic(z) = w
         End If
     End If
 Next
 Me.ListBox1.List = dic.keys
 End Sub

 Private Sub ListBox1_Click()
 Me.ListBox2.Clear
 Me.ListBox3.Clear
 With Me.ListBox1
     If .ListIndex <> -1 Then
         Me.Listbox2.List = dic(.Value)
     End If
 End With
 End Sub

 Private Sub ListBox2_Click()
 With Me
     If (.ListBox1.ListIndex <> -1) * (.ListBox2.ListIndex <> -1) Then
         .ListBox3.List = dic(.ListBox2.Value & ";" & .ListBox2.Value)
     End If
 End With
 End Sub
 (seiya)


 おじゃまします。
 以下は参考になりませんか?
[[20081217082039]]『3つ以上のコンボボックス連携について』(Voume11)
[[20090924220534]] 『同一フォーム上に2組の連携するコンボボックスを作成』(SJC)

 「リスト」シート データレイアウト 
	A	B	C
	社名	部署	氏名
	マクロシステム	広報部	橋本
	マクロシステム	営業部	高山
	マクロシステム	営業部	岡田
	マクロシステム	広報部	平山
	マクロシステム	広報部	須藤
	マクロシステム	広報部	加藤
	マクロシステム	開発部	君島
	マクロシステム	開発部	村上
	マクロシステム	開発部	荒川
	マクロシステム	営業部	丸山
	マクロシステム	開発部	佐々木
	キーテクノロジー	企画部	大貫
	キーテクノロジー	広報部	佐藤
	キーテクノロジー	広報部	鈴木
	キーテクノロジー	開発部	山口
	キーテクノロジー	営業部	山本
	キーテクノロジー	広報部	吉田
	キーテクノロジー	営業部	坂本
	キーテクノロジー	営業部	手塚
	キーテクノロジー	広報部	野口
	キーテクノロジー	広報部	野沢
	デジタルウェア	広報部	遠藤
	デジタルウェア	開発部	神山
	デジタルウェア	開発部	川島
	デジタルウェア	開発部	上野
	デジタルウェア	営業部	新井
	デジタルウェア	開発部	高久
	デジタルウェア	企画部	田代
	デジタルウェア	広報部	中田
	デジタルウェア	広報部	菊池
	デジタルウェア	開発部	高橋
	デジタルウェア	営業部	小池
	デジタルウェア	広報部	増淵
	デジタルウェア	営業部	石川
	デジタルウェア	営業部	益子
	デジタルウェア	広報部	大塚
	デジタルウェア	広報部	中島
	デジタルウェア	広報部	小倉
	デジタルウェア	開発部	栗原

 (上のレイアウト例では A列がグループ化されてますが、
  以下のコードでは グループ化されていなくても可能です)
 '◆ Microsoft Scripting Runtime への参照設定が必要です
    VBEメニュ−の[ツール]-[参照設定]より 上記のランタイムライブラリに
    チェックを入れておいてください

 '----------------------------------------------------------- UserForm モジュール
 Option Explicit

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

 Private Sub UserForm_Initialize()
    Dim v, sKey As String
    Dim i As Long, colm 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 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
        .List = Application.Transpose(Array(dic(1).keys, dic(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
 End Sub

 Private Sub ComboBox1_Change()
    ComboBox_Update ComboBox1, ComboBox2
 End Sub

 Private Sub ComboBox2_Change()
    ComboBox_Update ComboBox2, ComboBox3
 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
        .ListIndex = 0
    End With
 End Sub

 (kanabun) 2009-10-08 15:46


みなさんありがとうございます。

momoさん何回もすみません。

commobox1_change()

でsplitしてできたものを重複データをなくしたものにできませんか?


 他の回答者の方々のコードも試してみてくださいね。
 頭の中だけで書いたコードなのでテストしてません。(seiyaさんの凄さが解る・・・)

  Private myDic1 As Object
  Private myDic2 As Object

  Private Sub UserForm_Initialize()
  Dim v, i As Long
  v = Worksheets("リスト").Range("A1").CurrentRegion.Value
  Set myDic1 = CreateObject("Scripting.Dictionary")
  Set myDic2 = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(v)
    myDic1.Item(v(i, 1)) = myDic1.Item(v(i, 1)) & vbTab & v(i, 2)
    myDic2.Item(v(i, 1) & vbTab & v(i, 2)) = myDic2.Item(v(i, 1) & vbTab & v(i, 2)) & vbTab & v(i, 3)
  Next i
  Me.ComboBox1.List = myDic1.keys
  End Sub

  Private Sub ComboBox1_Change()
  Dim v As Variant, i As Long
  v = Split(Mid$(myDic1.Item(Me.ComboBox1.Value), 2), vbTab)
  With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(v)
      If Not .Exists(v(i)) Then .Add v(i), ""
    Next i
    v = .keys
  End With
  Me.ComboBox2.List = v
  End Sub

  Private Sub ComboBox2_Change()
  Dim v As Variant, i As Long
  v = Split(Mid$(myDic2.Item(Me.ComboBox1.Value & vbTab & Me.ComboBox2.Value), 2), vbTab)
  With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(v)
      If Not .Exists(v(i)) Then .Add v(i), ""
    Next i
    v = .keys
  End With
  Me.ComboBox3.List = v
  End Sub

 (momo)

momoさんありがとうございます。

まんまコピーして使わせていただきました。うまくいきました。

他の方のコードも使わせていただいて、試してみようとおもいます。

なにぶん素人なので、今回のコードもすこしずつ勉強して理解していきます。

みなさんありがとうございました。

(みー)


コメント返信:

[ 一覧(最新更新順) ]


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