Excel VBA質問箱 IV

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

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


42799 / 76732 ←次へ | 前へ→

【38995】Re:3つのコンボボックスで絞込検索
質問  しょしーん  - 06/6/15(木) 17:44 -

引用なし
パスワード
   Jakaさん
レスありがとうございます。

試してみたのですが…やっぱりできませんでした(;;)

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, ListBox2.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
   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, ListBox3.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()
MsgBox ComboBox3.List(ComboBox3.ListIndex)
End Sub

▼標準モジュールに
Public CE As Long

Sub 絞込み2()
  Dim Ctl As Range, LbTb() As String, Cnt As Long
  Worksheets("工事データ").AutoFilterMode = False
  CE = ActiveSheet.Range("C65536").End(xlUp).Row
  ActiveSheet.Range("C1:C" & CE).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
  CAE = Range("C2").End(xlDown).Row
  Set Ctl = ActiveSheet.Range("C2:C" & CAE).SpecialCells(xlCellTypeVisible)
  ActiveSheet.AutoFilterMode = False
  ActiveSheet.ShowAllData
  DoEvents
  Cnt = 0
  For Each ccc In Ctl
    Cnt = Cnt + 1
    ReDim Preserve LbTb(1 To Cnt)
    LbTb(Cnt) = ccc
  Next
  工事検索.ComboBox1.List = LbTb
  Set Ctl = Nothing
  Erase LbTb
  Application.ScreenUpdating = True
  工事検索.Show
End Sub

で、どこが違うのでしょうか?
ちなみにコンボボックスのあるフォームが「工事検索」で、データのあるシートが「工事データ」です。
何卒、お力添えをお願いします。

5 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 お礼

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