リストボックス複数選択抽出方法

Question

いつもお世話になっております

下記の部分を複数選択したいのですが
どうしたよろしいでしょうか

If r.Value = ListBox1.List(ListBox1.ListIndex) Then

A列　担当
Ｂ列　名前
Ｃ列　性別

Private Sub UserForm_initialize()
With ListBox1
.AddItem "工藤"
.AddItem "加藤"
.AddItem "遠藤"
.AddItem "佐藤"
.Font.Size = 14
.MultiSelect = fmMultiSelectMulti
End With
End Sub


Private Sub CommandButton1_Click()
Dim dic As Object
Dim r As Range, rr As Range
Dim key1, key2, i As Integer

Set dic = CreateObject("Scripting.Dictionary")

For Each r In Range("A2", Cells(Rows.Count, "A").End(xlUp))
If r.Value = ListBox1.List(ListBox1.ListIndex) Then


If Not dic.exists(r.Value) Then dic.Add r.Value, _
CreateObject("Scripting.Dictionary")

If Not dic(r.Value).exists(r.Offset(, 1).Value) Then _
dic(r.Value).Add r.Offset(, 1).Value, _
CreateObject("System.Collections.ArrayList")

dic(r.Value)(r.Offset(, 1).Value).Add (r.Offset(, 2).Value)
End If

Next

Set rr = Range("F2")
Range("F:H").Clear

For Each key1 In dic.keys
rr.Value = key1
For Each key2 In dic(key1).keys
Set rr = rr.Offset(1)
rr.Offset(, 1).Value = key2
Set rr = rr.Offset(1)
For i = 0 To dic(key1)(key2).Count - 1
rr.Offset(i, 2).Value = dic(key1)(key2)(i)
Next
Set rr = rr.Offset(dic(key1)(key2).Count - 1)
Next
Set rr = rr.Offset(1)
Next

Set dic = Nothing

End Sub

初心者ですが何か。 · Accepted Answer

取り敢えず形にはなっているでしょうか？

Dim dic1 As Object

Private Sub UserForm_Initialize()
Dim r As Range
Dim st As String

With ListBox1
.AddItem "工藤"
.AddItem "加藤"
.AddItem "遠藤"
.AddItem "佐藤"
.Font.Size = 14
.MultiSelect = fmMultiSelectMulti
End With

Set dic1 = CreateObject("Scripting.Dictionary")

For Each r In Range("A2", Cells(Rows.Count, "A").End(xlUp))
With Application
st = Join(.Index(r.Resize(, 2).Value, 1, 0), "_")

If Not dic1.Exists(st) Then dic1.Add st, .Index(r.Range("B1:D1").Value, 1, 0)

End With
Next

End Sub

Private Sub CommandButton1_Click()
Dim key As Variant
Dim rf As Range
Dim i As Long
Dim v As Variant

Set rf = Range("F2")
Range("F:H").Clear

For i = 0 To ListBox1.ListCount - 1

For Each key In dic1.Keys
If ListBox1.Selected(i) = True Then
If key Like ListBox1.List(i) & "*" Then

v = dic1(key)
rf.Resize(, 3).Value = v
Set rf = rf.Offset(1)

End If
End If
Next
Next

End Sub

初心者ですが何か。 · Answer

まずＡ列の重複と言うのは、担当：お客様が１：１なのか１：多なのかを確認したかったのです。
それにより出力される件数は 選択した数 or 担当しているお客様数 と行数が変わりますので。
ダミーデータを提示されるならその辺を気にされた方が宜しいかも。

あと担当者が入れ替わりなど多い場合なら、どこか空いている列に一覧を作成し 
RowSourceプロパティ
http://officetanaka.net/excel/vba/tips/tips139.htm
を用いるのと後々管理は楽かなと。

本題についてはちょっとお時間を。

初心者ですが何か。 · Answer

No.3 です。

お礼の内容からすると解決したと言う事であれば、その旨記載して欲しいです。
Ａ列に重複がなければDictionaryオブジェクトは不要でしょうし、仮にあるのならそのItemにDictionaryオブジェクトは不要でしょう。
ただＢ列に重複があるか否か次第ですけど。

初心者ですが何か。 · Answer

ListBoxの担当者が抱える？顧客名一覧を書き出したいとかでしょうかね。

取り敢えずユーザーフォームを表示している間はデータの書き換えや追加・削除がなければ、dicへの登録はUserForm_initialize()イベントで行ないdicの宣言はプロシージャー外で行った方が見やすそうに感じます。
⇒書き換える必要があるならスル～で。
若しくはデータが多いとかでしょうか？

Dim dic As Object 'イベントの前に書いておく

Private Sub UserForm_initialize()
・・・・

＞例えば　担当　工藤　加藤　選択したら
＞その、担当の　名前　性別　血液型を

担当者名はなくても宜しいのでしょうか？
また名前が重複（同じ担当者で）するようなデータ構築されているのですか？

ShowMeHow · Answer

For Each r In Range("A2", Cells(Rows.Count, "A").End(xlUp))
If r.Value = ListBox1.List(ListBox1.ListIndex) Then

エクセルのVBAは使ったことがないので、的を射ていない質問かもしれませんが、上記の行では何をしたいのでしょうか？
・範囲を指定して、それぞれのセルの値がリストボックスで選ばれたもののいずれかと合致している場合以下の処理をする

（以下の処理）
　・一度dic という配列に突っ込み
　・セルF2に表示させる

というようなことでしたら、ループを二重にしないと、それぞれのセルの値ということにはなりません。

例えばの話、

A　　　　　B　　　　C
佐藤　　　阿部　　　男
佐藤　　　井口　　　女
加藤　　　伊藤　　　女
遠藤　　　宇野　　　男
佐藤　　　江口　　　女
藤本　　　小野　　　男
工藤　　　加賀　　　男
佐藤　　　木村　　　女

のように入っていて、リストボックスで　佐藤、工藤　を選択したら、F2に何を表示させたいのですか？

ShowMeHow · Answer

コード読んでいないけど、、、
リストボックスのmultiselect の使い方はこんな感じかな？
http://officetanaka.net/excel/vba/tips/tips144.htm

ぶっちゃけ、選択されたリストをどのように使いたいのかな？

リストボックス複数選択抽出方法

取り敢えず形にはなっているでしょうか？

まずＡ列の重複と言うのは、担当：お客様が１：１なのか１：多なのかを確認したかったのです。

No.3 です。

ListBoxの担当者が抱える？顧客名一覧を書き出したいとかでしょうかね。

For Each r In Range("A2", Cells(Rows.Count, "A").End(xlUp))

コード読んでいないけど、、、

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング