[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『コンボボックスについて』（ミー）
ユーザーフォームのコンボボックスにリスト表示させたいのですが、sheets("リスト")の
Ａ１からＣ２４０までのリストがあって、Ａ列社名、Ｂ列氏名、Ｃ列ＩＤとなっています。
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
としたのですが、最初に検索されたｃ.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さんのサンプルコードを使ってみました。
質問に少し追加させていただきます。
Vに格納するリストが３列あった場合で
myDic.Item(v(i, 1)) = myDic.Item(v(i, 1)) & vbTab & v(i, 2) & vbTab & v(i, 3)
とするとcombobox1にはＡ列の重複しないリストが表示されますよね。
それで、combobox2にはcombobox1_changeでＢ列の重複しないリスト
combobox3にはcombobox2_changeでＣ列の重複しないリスト
が
表示されるようにしたいのですが、
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)
とすると、Ｂ列Ｃ列両方が表示されます。
どうしたらよいのでしょうか？
単純にDictionaryを２つ作ってあげた方が処理としては簡単です。 もちろん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
（ｍｏｍｏ）
すいません。私の質問の仕方が悪かったですね。はしょってしまいました。
リスト表ですが、下記のようになっています。
Ａ Ｂ Ｃ １ 社名 部署 氏名 ２ ○社 ○課 ○○ ３ ○社 △課 ×× ４ ×社 ○課 △△ ５ △社 ×課 ○△ ６ ○社 ○課 ○× ７ ×社 ○課 ×○ ・ ・ ・ ・ ・ ・ ・ ・
となっていまして、combobox1にＡ列の重複しないリストを表示し、combobox1で選択したら、
combobox1.valueかつＢ列の重複しないリストが表示、combobox2で選択したら、
combobox1.valueかつcombobox2.valueかつＣ列の重複しないリストが表示できるようにしたいのです。
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
（ｍｏｍｏ）
これで試してください。
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]] 『同一フォーム上に２組の連携するコンボボックスを作成』（ＳＪＣ）
「リスト」シート データレイアウト 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
（ｍｏｍｏ）
まんまコピーして使わせていただきました。うまくいきました。
他の方のコードも使わせていただいて、試してみようとおもいます。
なにぶん素人なので、今回のコードもすこしずつ勉強して理解していきます。
みなさんありがとうございました。
（みー）
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.