Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


42769 / 76735 ←次へ | 前へ→

【39028】Re:3つのコンボボックスで絞込検索
発言  Jaka  - 06/6/16(金) 10:58 -

引用なし
パスワード
   >     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
0 hits

【38980】3つのコンボボックスで絞込検索 しょしーん 06/6/15(木) 16:33 質問
【38981】Re:3つのコンボボックスで絞込検索 Jaka 06/6/15(木) 16:36 回答
【38987】Re:3つのコンボボックスで絞込検索 しょしーん 06/6/15(木) 16:47 質問
【38991】Re:3つのコンボボックスで絞込検索 Jaka 06/6/15(木) 17:19 発言
【38995】Re:3つのコンボボックスで絞込検索 しょしーん 06/6/15(木) 17:44 質問
【39023】Re:3つのコンボボックスで絞込検索 Jaka 06/6/16(金) 9:57 発言
【39024】Re:3つのコンボボックスで絞込検索 774 06/6/16(金) 10:03 発言
【39026】Re:3つのコンボボックスで絞込検索 しょしーん 06/6/16(金) 10:25 お礼
【39027】Re:3つのコンボボックスで絞込検索 774 06/6/16(金) 10:28 発言
【39028】Re:3つのコンボボックスで絞込検索 Jaka 06/6/16(金) 10:58 発言
【39035】Re:3つのコンボボックスで絞込検索 しょしーん 06/6/16(金) 11:40 お礼

42769 / 76735 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free