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

いつもお世話になっております

下記の部分を複数選択したいのですが
どうしたよろしいでしょうか

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

質問者からの補足コメント

• 

  返信遅れてすみません。
  担当を複数選択して抽出したいのですが、
  For i = 0 To ListBox1.ListCount - 1
  If r.Value = ListBox1.Selected(i) Then
  に修正しましたが、エラーにはなりませんでしたが、
  なにも　表示されませんでした
  おしえてくれませんでしょうか

  No.1の回答に寄せられた補足コメントです。 補足日時：2023/10/20 09:37

• 

  すみません。説明不足でした
  Ａ列　　Ｂ列　　　　Ｃ列　　Ｄ列
  担当 　名前 　　性別 血液型
  工藤 　根岸 育雄 男 　A
  加藤 　小田 都義 女 　A
  遠藤 　高松 友良 男 　A
  佐藤 　村瀬 一樹 女 　A
  
  リストボックス１に表示されているのが
  Ａ列の担当
  例えば　担当　工藤　加藤　選択したら
  その、担当の　名前　性別　血液型を
  表示させたいです。
  autofiter ではなく。

  No.2の回答に寄せられた補足コメントです。 補足日時：2023/10/20 11:03

• 

  すみません　解決していません。
  Ａ列に重複がなければ　ではなく
  単純に　工藤　加藤　が選択されたら
  工藤　加藤の　
  
  名前（お客様） 性別 血液型
  をすべて　表示させたいだけです、。

  No.4の回答に寄せられた補足コメントです。 補足日時：2023/10/20 13:07

• 担当：お客様が１：１なのか１：多なのか
  提示したデータはお客様が１：１となっていますが、
  １：多です
  すみませんでした

  No.5の回答に寄せられた補足コメントです。 補足日時：2023/10/20 13:40

No.6 ベストアンサー 回答者： 初心者ですが何か。 回答日時： 2023/10/20 14:46

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

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

この回答へのお礼

ありがとうございました。

お礼日時：2023/10/20 16:58

No.5 回答者： 初心者ですが何か。 回答日時： 2023/10/20 13:24

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

それにより出力される件数は 選択した数 or 担当しているお客様数 と行数が変わりますので。
ダミーデータを提示されるならその辺を気にされた方が宜しいかも。

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

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

No.4 回答者： 初心者ですが何か。 回答日時： 2023/10/20 13:01

No.3 です。

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

No.3 回答者： 初心者ですが何か。 回答日時： 2023/10/20 11:41

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

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

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

Private Sub UserForm_initialize()
・・・・

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

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

この回答へのお礼

ありがとうございます
いろいろありがとうございました。

お礼日時：2023/10/20 12:00

No.2 回答者： ShowMeHow 回答日時： 2023/10/20 10:54

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に何を表示させたいのですか？

No.1 回答者： ShowMeHow 回答日時： 2023/10/18 18:11

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

リストボックスのmultiselect の使い方はこんな感じかな？
http://officetanaka.net/excel/vba/tips/tips144.htm

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

この回答へのお礼

ありがとうございました。

お礼日時：2023/10/20 12:00