Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
7464 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【38980】３つのコンボボックスで絞込検索 しょしーん 06/6/15(木) 16:33 質問[未読]
【38981】Re:３つのコンボボックスで絞込検索 Jaka 06/6/15(木) 16:36 回答[未読]
【38987】Re:３つのコンボボックスで絞込検索 しょしーん 06/6/15(木) 16:47 質問[未読]
【38991】Re:３つのコンボボックスで絞込検索 Jaka 06/6/15(木) 17:19 発言[未読]
【38995】Re:３つのコンボボックスで絞込検索 しょしーん 06/6/15(木) 17:44 質問[未読]
【39023】Re:３つのコンボボックスで絞込検索 Jaka 06/6/16(金) 9:57 発言[未読]
【39024】Re:３つのコンボボックスで絞込検索 774 06/6/16(金) 10:03 発言[未読]
【39026】Re:３つのコンボボックスで絞込検索 しょしーん 06/6/16(金) 10:25 お礼[未読]
【39027】Re:３つのコンボボックスで絞込検索 774 06/6/16(金) 10:28 発言[未読]
【39028】Re:３つのコンボボックスで絞込検索 Jaka 06/6/16(金) 10:58 発言[未読]
【39035】Re:３つのコンボボックスで絞込検索 しょしーん 06/6/16(金) 11:40 お礼[未読]
【38980】３つのコンボボックスで絞込検索
質問  しょしーん  - 06/6/15(木) 16:33 -
引用なし
パスワード
   シート上のＡ、Ｂ、Ｃ列それぞれ重複するデータがあり、それをユーザーフォーム上の３つのコンボボックスで絞込検索をしたいと思っています。
いろいろ探し回ったのですが、さっぱりよく分かりません。
皆様、何卒ご回答宜しく御願致します。
【38981】Re:３つのコンボボックスで絞込検索
回答  Jaka  - 06/6/15(木) 16:36 -
引用なし
パスワード
   http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=84;id=FAQ
【38987】Re:３つのコンボボックスで絞込検索
質問  しょしーん  - 06/6/15(木) 16:47 -
引用なし
パスワード
   Jakaさん
レスありがとうございます。

以前そこは発見したのですが、リストボックスをコンボボックスに置き換えるだけでよろしいのでしょうか？
【38991】Re:３つのコンボボックスで絞込検索
発言  Jaka  - 06/6/15(木) 17:19 -
引用なし
パスワード
   ▼しょしーん さん：
>以前そこは発見したのですが、リストボックスをコンボボックスに置き換えるだけでよろしいのでしょうか？
はい、コンボもリストボックスも書き方はほとんど同じですが、クリックとチェンジイベントの違いはあります。
その辺を改良してください。
【38995】Re:３つのコンボボックスで絞込検索
質問  しょしーん  - 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:３つのコンボボックスで絞込検索
発言  Jaka  - 06/6/16(金) 9:57 -
引用なし
パスワード
   忘れていたことがあります。
配列、またCombobox等のListに対して、エクセル関数（Match関数など）は、5800件ぐらいまでにしか対応していませんでした。
場合によっては他のやり方に変えなくてはなりません。
すみません。
【39024】Re:３つのコンボボックスで絞込検索
発言  774  - 06/6/16(金) 10:03 -
引用なし
パスワード
   http://www2.moug.net/bbs/exvba/20060615000031.htm

> で、見よう見まねでここまでやりました。
なに自分の力だけでコード書いたようにいってるんだか。saite-
【39026】Re:３つのコンボボックスで絞込検索
お礼  しょしーん  - 06/6/16(金) 10:25 -
引用なし
パスワード
   Jakaさん
そうですか。
分かりました。
かなりの知識不足なので、自分なりにもう少し勉強してからまた質問することにします。
ありがとうございました。


774さん
>なに自分の力だけでコード書いたようにいってるんだか。saite-
だから、見よう見まねと書いたはずですよ？
誰も自分の力とは書いていません。
確かに、同じ質問を他でも聞いた事は悪いと思っていますが、どうしても解決策が分からなかったため多数の人の意見を聞きたかっただけです。
【39027】Re:３つのコンボボックスで絞込検索
発言  774  - 06/6/16(金) 10:28 -
引用なし
パスワード
   >確かに、同じ質問を他でも聞いた事は悪いと思っていますが、どうしても解決策が分からなかったため多数の人の意見を聞きたかっただけです。
あちらの掲示板ではこのような「マルチポスト」行為は

禁止

事項です。(こちらでは容認されているが)
【39028】Re:３つのコンボボックスで絞込検索
発言  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:３つのコンボボックスで絞込検索
お礼  しょしーん  - 06/6/16(金) 11:40 -
引用なし
パスワード
   Jakaさん

大変参考になりました。
いろいろ試しながら、勉強してみます。
今度質問するときは正当な手段をとりますので、そのときはよろしくお願いいたします。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
7464 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free