Excel マクロ リストボックス複数選択

いろいろ拝見させていただいているのですが
理解が低いのが原因で困っています。



データのシートがあります。
・B列には、起点となる人の名前が記載（300名ほど）
・データの入っている列は、A：CE

データシートでB列にてオートフィルタをかけ
抽出シートに転記したい。

抽出シートでは、ユーザーフォームを組みました。
オプションボタン1　単一選択
オプションボタン2　複数選択
オプションボタン3　拡張選択
リストボックス（2・3に対して）
コマンドボタン　　 終了

とした場合、単一選択はできたのですが
複数選択の場合
該当数が「0」の表記となってしまい、うまくいきません。

同じような質問が…というお返事があることを承知でお伺いしています。
いただいた回答を基に、勉強をしていきたいと思っていますので
なにとぞよろしくお願い申し上げます。




Private Sub UserForm_Initialize()
ListBox1.ColumnCount = 1 'リストボックスの列は1
ListBox1.BoundColumn = 0 'ListIndexの値（行数）を使用する
ListBox1.MultiSelect = 0 '最初は単一選択状態にする
ListBox1.RowSource = 'リストのソース
ListBox1.ColumnHeads = True '列見出し表示
OptionButton1.Value = -1 'オプションボタン1を選択状態にする
End Sub

Private Sub OptionButton1_Click()
ListBox1.MultiSelect = fmMultiSelectSingle '単一選択状態にする
End Sub

Private Sub OptionButton2_Click()
ListBox1.MultiSelect = fmMultiSelectMulti '複数選択状態にする
End Sub

Private Sub OptionButton3_Click()
ListBox1.MultiSelect = fmMultiSelectExtended '拡張（連続）選択状態にする
End Sub

Private Sub ListBox1_Click() 'リストボックスがクリックされたとき（単一選択）

Dim 条件 As String

条件 = UserForm1.ListBox1.Text '氏名

With Worksheets("データ")
.Range("A1").AutoFilter _
field:=2, Criteria1:=条件

.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _
Worksheets("抽出").Range("A1")

.Range("A1").AutoFilter

End With

End Sub


Private Sub CommandButton1_Click() '選択終了ボタンがクリックされたとき（複数・拡張選択）

Dim 条件 As　String
Dim lastRow As Long

With ListBox1
If .ListIndex = -1 Then Exit Sub '何も選択されていない

For 条件 = 0 To .ListCount - 1
If .Selected(条件) Then '行選択あり

With Worksheets("データ")
.Range("A1").AutoFilter _
field:=2, Criteria1:=条件

.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _
Worksheets("抽出").Range("A1")

.Range("A1").AutoFilter


End With

End If
Next
End With


End Sub

Private Sub UserForm_Deactivate()
Unload UserForm1 '×ボタンを押したら、ユーザーフォームのunloadをする
End Sub

No.1 回答者： kybo 回答日時： 2013/03/12 13:19

変更すべき点は以下の★部分です。

Private Sub CommandButton1_Click()
Dim 条件 As Integer '★
Dim lastRow As Long

With ListBox1
If .ListIndex = -1 Then Exit Sub '何も選択されていない

For 条件 = 0 To .ListCount - 1
If .Selected(条件) Then '行選択あり
With Worksheets("データ")
.Range("A1").AutoFilter _
field:=2, Criteria1:=.List(条件)　’★

.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _
Worksheets("抽出").Range("A1")

.Range("A1").AutoFilter


End With

End If
Next
End With


End Sub

この回答へのお礼

早速のご回答、ありがとうございました。

★のところを変更したのですが、オブジェクトはこのプロパティ及び…とエラーがでましたので

field:=2, Criteria1:= ListBox1.List(条件)　

で作業をしてみました。

そうすると、リストボックスで複数選択した中の一番下の名前だけに対して抽出がされてしまいます。
お教えいただいた中で、理解ができておらず申し訳ありません。

重ねてご教授いただけたらと思います。
よろしくお願い申し上げます。

なお、上記の中で
Dim lastRow As Long　は消し忘れた内容でした。
失礼いたしました。

お礼日時：2013/03/12 15:31

No.2 回答者： kybo 回答日時： 2013/03/13 13:16

フィルタして、コピー先が常にA1になっているからです。

「Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _
Worksheets("抽出").Range("A1")」の部分

仮に、1番上の行が見出しなんだとすると、それを最初だけコピーするコードにしないといけません。


表のサイズが不明だったので、2列しかないと仮定しています。
Range("A1:B1")の部分のBはそちらの表に合わして、変更して下さい。


Private Sub CommandButton1_Click()
Dim 条件 As Integer
Dim lastRow As Long
With ListBox1
If .ListIndex = -1 Then Exit Sub '何も選択されていない

’◆
Worksheets("データ").Range("A1:B1").Copy Worksheets("抽出").Range("A1")
For 条件 = 0 To .ListCount - 1
If .Selected(条件) Then '行選択あり
With Worksheets("データ")
.Range("A1").AutoFilter _
field:=2, Criteria1:=ListBox1.List(条件)

’◆
.Range("A2:B" & .Range("A" & .Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy _
Worksheets("抽出").Range("A" & Worksheets("抽出").Range("A" & Worksheets("抽出").Rows.Count).End(xlUp).Offset(1).Row)
.AutoFilterMode = False
End With
End If
Next
End With
End Sub


あと、リストのデータの反映の仕方が不明ですが、「RowSource 」にA1:B10とかセルを参照している場合は、オートフィルタの動作が不安定になるので、RowSource は空欄にして、以下の様にユーザーフォーム起動時に、値を代入して下さい。


Private Sub UserForm_Initialize()
Dim I As Integer
For I = 1 To Range("A" & Rows.Count).End(xlUp).Row
ListBox1.AddItem Range("A" & I).Value
Next I
End Sub