連動するリストボックスで全選択する方法　（エクセル　vba）

エクセル　vba　連動するリストボックスで全選択する方法

ユーザーフォーム上にリストボックスを３個おいています。
リストはそれぞれ連動していて
ListBox1（10項目くらい）をすべて選択するとListBox2に120項目くらい表示されます。
ListBox2をすべて選択するとListBox3に4,000項目くらい表示されます。
それぞれのリストボックスに全選択と全解除のボタンをつけたのですが、ListBox2の全選択、全解除を実行すると大変時間がかかります。
理由はなんとなく理解している(ListBox2の項目数の回数、ListBox3を書き直している）
ですが、回避する方法を思いつきません。
（手動で1項目ずつ選択することについては不都合はありません）
プログラミング、vbaは初心者で、ネットで必要なコードを調べながら書いています。体系的に勉強していないので思いつく方法に限界があります。コードは自分で調べますので、処理の方法を教えていただけたら幸甚に存じます。

該当のソースコード

Private Sub CommandButton13_Click()
Dim i As Long
If ListBox2.ListCount = Empty Then
Else
For i = 0 To ListBox2.ListCount - 1
ListBox2.Selected(i) = True
Next i
End If
End Sub

Private Sub ListBox2_Change()
Dim i, p As Long
Dim arrSelect() As Variant
i = 0
For p = 0 To ListBox2.ListCount - 1
If ListBox2.Selected(p) Then
ReDim Preserve arrSelect(i)
arrSelect(i) = ListBox2.List(p, 0)
i = i + 1
End If
Next p
If i = 0 Then
ListBox3.Clear
Else
CreateListBox3 (arrSelect)
End If
End Sub

Private Function CreateListBox3(ByRef arrSelect As Variant)
Dim a, b, c, i, j, k, l As Long
Dim arrwsData As Variant
Dim arr(4) As Variant
Dim arr1 As Variant
Dim arrData As Variant
Dim FD As Date
Dim LD As Date
Dim Dt As Date
Dim M1 As Date
Dim M2 As Date
Dim Y1 As Date
Dt = Date
M1 = DateAdd("m", -1, Dt)
M2 = DateAdd("m", -3, Dt)
If Month(Date) <= 3 Then
Y1 = Year(Date) - 1 & "/4/1"
Else
Y1 = Year(Date) & "/4/1"
End If
If OptionButton1 Then
FD = M1
ElseIf OptionButton2 Then
FD = M2
ElseIf OptionButton3 Then
FD = Y1
ElseIf OptionButton4 Then
FD = 1
End If
a = Worksheets("DataSheet").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("DataSheet").Activate
arrwsData = Worksheets("DataSheet").Range(Cells(2, 1), Cells(a, 22))

Dim drData As New Collection
For i = 0 To a - 2
    If arrwsData(i + 1, 4) >= FD Then
        For j = 0 To UBound(arrSelect, 1)
            If arrwsData(i + 1, 7) = arrSelect(j) Then
                arr(0) = arrwsData(i + 1, 1)
                arr(1) = arrwsData(i + 1, 2)
                arr(2) = arrwsData(i + 1, 5)
                arr(3) = arrwsData(i + 1, 7)
                arr(4) = arrwsData(i + 1, 4)
                drData.Add Item:=arr
            End If
        Next j
    End If
Next i

If drData.Count = Empty Then
    ListBox3.Clear
Else
    ReDim arrData(drData.Count - 1, 4)
    For k = 0 To drData.Count - 1
        arr1 = drData.Item(k + 1)
        arrData(k, 0) = arr1(0)
        arrData(k, 1) = arr1(1)
        arrData(k, 2) = arr1(2)
        arrData(k, 3) = arr1(3)
        arrData(k, 4) = arr1(4)
    Next k
ListBox3.List = arrData
End If

With ListBox3
    .MultiSelect = fmMultiSelectMulti
    .ListStyle = fmListStyleOption
End With

End Function

行動規範の内容に同意します

回答2件

ベストアンサー

残念ながらユーザーフォーム上のコントロールはイベントを抑制することはできません。
なのでフラグを利用して処理を抜けることが多いです。

VBA
1Private Flag As Boolean
2
3Private Sub CommandButton13_Click()
4    Flag = False
5    '略
6    Flag = True
7End Sub
8
9Private Sub ListBox2_Change()
10    If Flag = False Then Exit Sub
11    '略
12End Sub