Excel VBA質問箱 IV

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

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


7463 / 13644 ツリー ←次へ | 前へ→

【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 お礼[未読]

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

引用なし
パスワード
   シート上のA、B、C列それぞれ重複するデータがあり、それをユーザーフォーム上の3つのコンボボックスで絞込検索をしたいと思っています。
いろいろ探し回ったのですが、さっぱりよく分かりません。
皆様、何卒ご回答宜しく御願致します。

【38981】Re:3つのコンボボックスで絞込検索
回答  Jaka  - 06/6/15(木) 16:36 -

引用なし
パスワード
   http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=84;id=FAQ

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

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

以前そこは発見したのですが、リストボックスをコンボボックスに置き換えるだけでよろしいのでしょうか?

【38991】Re:3つのコンボボックスで絞込検索
発言  Jaka  - 06/6/15(木) 17:19 -

引用なし
パスワード
   ▼しょしーん さん:
>以前そこは発見したのですが、リストボックスをコンボボックスに置き換えるだけでよろしいのでしょうか?
はい、コンボもリストボックスも書き方はほとんど同じですが、クリックとチェンジイベントの違いはあります。
その辺を改良してください。

【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

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

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

引用なし
パスワード
   忘れていたことがあります。
配列、またCombobox等のListに対して、エクセル関数(Match関数など)は、5800件ぐらいまでにしか対応していませんでした。
場合によっては他のやり方に変えなくてはなりません。
すみません。

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

引用なし
パスワード
   http://www2.moug.net/bbs/exvba/20060615000031.htm

> で、見よう見まねでここまでやりました。
なに自分の力だけでコード書いたようにいってるんだか。saite-

【39026】Re:3つのコンボボックスで絞込検索
お礼  しょしーん  - 06/6/16(金) 10:25 -

引用なし
パスワード
   Jakaさん
そうですか。
分かりました。
かなりの知識不足なので、自分なりにもう少し勉強してからまた質問することにします。
ありがとうございました。


774さん
>なに自分の力だけでコード書いたようにいってるんだか。saite-
だから、見よう見まねと書いたはずですよ?
誰も自分の力とは書いていません。
確かに、同じ質問を他でも聞いた事は悪いと思っていますが、どうしても解決策が分からなかったため多数の人の意見を聞きたかっただけです。

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

引用なし
パスワード
   >確かに、同じ質問を他でも聞いた事は悪いと思っていますが、どうしても解決策が分からなかったため多数の人の意見を聞きたかっただけです。
あちらの掲示板ではこのような「マルチポスト」行為は

禁止

事項です。(こちらでは容認されているが)

【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

【39035】Re:3つのコンボボックスで絞込検索
お礼  しょしーん  - 06/6/16(金) 11:40 -

引用なし
パスワード
   Jakaさん

大変参考になりました。
いろいろ試しながら、勉強してみます。
今度質問するときは正当な手段をとりますので、そのときはよろしくお願いいたします。

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