| |
> mt = Application.Match(Cel, ListBox2.List, 0)
↑
ComboBox
それ以前に私が、
コンボボックスをクリアした時のChangeイベント発生のことを忘れてました。
30777件の郵政省のデータで試したら、フォームの起動が遅い事....。
最初は、Directoryの方が良いのかも、ほとんど使ったことないけど。
Private Sub ComboBox1_Change()
Dim CT2 As Range, Cel As Range, LB2tb() As String
Application.ScreenUpdating = False
ComboBox2.Clear
ComboBox3.Clear
If ActiveSheet.AutoFilterMode Then
ActiveSheet.AutoFilterMode = False
End If
LtW = ComboBox1.List(ComboBox1.ListIndex)
Range("A1").AutoFilter field:=3, Criteria1:=LtW
Set CT2 = Range("D2:D" & CE).SpecialCells(xlCellTypeVisible)
ComboBox2.Clear
Cnt = 0
For Each Cel In CT2
On Error Resume Next
mt = Application.Match(Cel, ComboBox2.List, 0)
If IsError(mt) Or mt = Empty Then
Cnt = Cnt + 1
ReDim Preserve LB2tb(1 To Cnt)
LB2tb(Cnt) = Cel
End If
ComboBox2.List = LB2tb
Err.Clear
On Error GoTo 0
Next
Set CT2 = Nothing
Erase LB2tb
Application.ScreenUpdating = True
End Sub
Private Sub ComboBox2_Change()
Dim CT3 As Range, Cel As Range, LB3tb() As String, mt As Variant
Application.ScreenUpdating = False
ComboBox3.Clear
If ComboBox2.ListIndex < 0 Then
If ComboBox2.ListCount > 0 Then
MsgBox "リストから選んでください。"
End If
Exit Sub
End If
LtW = ComboBox2.List(ComboBox2.ListIndex)
Range("A1").AutoFilter field:=4, Criteria1:=LtW
Set CT3 = Range("B2:B" & CE).SpecialCells(xlCellTypeVisible)
ComboBox3.Clear
Cnt = 0
For Each Cel In CT3
On Error Resume Next
mt = Application.Match(Cel, ComboBox3.List, 0)
If IsError(mt) Or mt = Empty Then
Cnt = Cnt + 1
ReDim Preserve LB3tb(1 To Cnt)
LB3tb(Cnt) = Cel
End If
ComboBox3.List = LB3tb
Err.Clear
On Error GoTo 0
Next
Set CT3 = Nothing
Erase LB3tb
Application.ScreenUpdating = True
End Sub
Private Sub ComboBox3_Change()
If ComboBox3.ListIndex < 0 Then
If ComboBox3.ListCount > 0 Then
MsgBox "リストから選んでください。"
End If
Exit Sub
End If
MsgBox ComboBox3.List(ComboBox3.ListIndex)
End Sub
|
|
Jaka
- 06/6/16(金) 10:58 -
