Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
8337 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【33888】複数の検索条件をクリアーした情報をリス... GREEN 06/1/23(月) 13:47 質問[未読]
【33893】Re:複数の検索条件をクリアーした情報を... GREEN 06/1/23(月) 14:28 質問[未読]
【33894】Re:複数の検索条件をクリアーした情報をリ... Statis 06/1/23(月) 14:32 回答[未読]
【33896】Re:複数の検索条件をクリアーした情報を... GREEN 06/1/23(月) 15:32 質問[未読]
【33897】Re:複数の検索条件をクリアーした情報を... Statis 06/1/23(月) 15:56 回答[未読]
【33901】Re:複数の検索条件をクリアーした情報を... GREEN 06/1/23(月) 16:18 お礼[未読]
【33906】Re:複数の検索条件をクリアーした情報を... Statis 06/1/23(月) 16:53 回答[未読]
【33911】Re:複数の検索条件をクリアーした情報を... GREEN 06/1/23(月) 17:13 お礼[未読]
【33888】複数の検索条件をクリアーした情報をリス...
質問  GREEN  - 06/1/23(月) 13:47 -
引用なし
パスワード
   いつもありがとうございます。
また困っています。ご助力を御願い致します。

ワークシートの情報
　　　Ａ　　　Ｂ　　　Ｃ　　　Ｄ　　　・・・
１
２　Ｎｏ．　区分　担当者　　直間　　　・・・
３　　１　　見積　　　Ａ　　　直　　　・・・
４　　２　　見積　　　Ｂ　　　間　　　・・・
５　　４　　引合　　　Ａ　　　直　　　・・・
６　　５　　見積　　　Ｂ　　　間　　　・・・
７　　８　　引合　　　Ｃ　　　間　　　・・・
・
・
・
と、いうような感じです。
行は入力をして増えていきますので限界は決まっていません。

区分・担当者・直間での複数検索でヒットした列のＮｏ．を
リストボックスに全て表示させたいのです。


Cells(1.2).Select
Selection.AutoFilter
ActiveSheet.AutoFilterMode = False

kub = ComboBox48.Value　　　'区分の検索条件入力
ttan = ComboBox49.Value　　 '担当者の検索条件入力
tyoku= ComboBox50.Value　　 '直間の検索条件の入力

Selection.AutoFilter
If kub <> "" Then
Selection.AutoFilter Field:=2, Criteria1:=kub　 '区分の検索条件がなければ無視
End If
If ttan <> "" Then
Selection.AutoFilter Field:=3, Criteria1:=ttan　'同じく、担当者
End If
If ttan <> "" Then
Selection.AutoFilter Field:=4, Criteria1:=tyoku '同じく、直間
End If

Dim CT2 As Range, Cel As Range, LB2tb() As String
CE = ActiveSheet.Range("A65536").End(xlUp).Row
Set CT2 = Range("A3:A" & CE).SpecialCells(xlCellTypeVisible)
ListBox1.Clear
ListBox1.List = CT2.Value
Set CT2 = Nothing


このように組んでみました。
それでマクロを走らせて区分の検索条件に「見積」を入力すると
リストボックスには、「１」「２」しか表示されません。
ワークシートを確認するとオートフィルターがかかっており
表示は、３行目（Ｎｏ．１）４行目（Ｎｏ．２）６行目（Ｎｏ．５）と
されています。

改善の方法を教えて頂けないでしょうか？
リストボックスに正常に表示がされるのでしたら、
オートフィルターにこだわりません。

宜しく御願い致します。
【33893】Re:複数の検索条件をクリアーした情報を...
質問  GREEN  - 06/1/23(月) 14:28 -
引用なし
パスワード
   Statisさんへ

早速のお返事ありがとうございます。

申し訳御座いませんでした。
仰るとおり、UserFormです。

それとオートフィルターを取得する前にとはどういう事でしょうか？
それは「オートフィルターをせずに各条件を抜き出す」と
いう意味でしょうか？
オートフィルターをせずに条件を抜き出す方法は、全くわかりませんでした。

別に今回は「オートフィルターを使わなくてはいけない」という条件では
ないですので、他に方法があればそれも是非に参考にしたいと思っています。

拙い知識で、このＨＰからいろいろと参考にさせて頂いての
組んだマクロですのでよくわかっていないのが現状です。
宜しく御願い致します。
【33894】Re:複数の検索条件をクリアーした情報を...
回答  Statis  - 06/1/23(月) 14:32 -
引用なし
パスワード
   ▼GREEN さん：
こんにちは
これで如何かな？

Dim CT2 As Range, CE As Long, C As Range
Dim kub As String, ttan As String, tyoku As String
With ActiveSheet
　　 CE = .Range("A65536").End(xlUp).Row
　　 If .AutoFilterMode = False Then
　　　　.Rows(2).AutoFilter
　　 End If
　　 kub = Me.ComboBox48.Value　　　'区分の検索条件入力
　　 ttan = Me.ComboBox49.Value　　 '担当者の検索条件入力
　　 tyoku = Me.ComboBox50.Value　　'直間の検索条件の入力
　　 If kub <> "" Then
　　　　.Range("B2:B" & CE).AutoFilter Field:=2, Criteria1:=kub　'区分の検索条件がなければ無視
　　 End If
　　 If ttan <> "" Then
　　　　.Range("C2:C" & CE).AutoFilter Field:=3, Criteria1:=ttan　'同じく、担当者
　　 End If
　　 If tyoku <> "" Then
　　　　.Range("D2:D" & CE).AutoFilter Field:=4, Criteria1:=tyoku '同じく、直間
　　 End If
　　 Set CT2 = .Range("A3:A" & CE).SpecialCells(xlCellTypeVisible)
　　 Me.ListBox1.Clear
　　 For Each C In CT2
　　　　 Me.ListBox1.AddItem C.Value
　　 Next C
　　 Set CT2 = Nothing
　　 .AutoFilterMode = False
End With
【33896】Re:複数の検索条件をクリアーした情報を...
質問  GREEN  - 06/1/23(月) 15:32 -
引用なし
パスワード
   Statisさんへ

ありがとうございます。
希望通りの表示ができました。

別件で御願いがあるのですが、

If .AutoFilterMode = False Then
　　.Rows(2).AutoFilter
End If
と
If kub <> "" Then
　.Range("B2:B" & CE).AutoFilter Field:=2, Criteria1:=kub　
End If
の「.Range("B2:B" & CE)」の部分の説明をお聞かせ頂けないでしょうか？
同じ質問をしないように理解をしたいと思っているのですが、
どうしてもわかりませんでした。
宜しく御願い致します。
【33897】Re:複数の検索条件をクリアーした情報を...
回答  Statis  - 06/1/23(月) 15:56 -
引用なし
パスワード
   こんにちは

'A列の最終データ行を取得=該当シートの最終データ行
　　 CE = .Range("A65536").End(xlUp).Row
　　 'シートにオートフィルタが設定されているかを確認。
　　 If .AutoFilterMode = False Then　'設定されていなければ
　　　　 '2行目にオートフィルタを設定
　　　　.Rows(2).AutoFilter
　　 End If
　　 kub = Me.ComboBox48.Value　　　'区分の検索条件入力
　　 ttan = Me.ComboBox49.Value　　 '担当者の検索条件入力
　　 tyoku = Me.ComboBox50.Value　　'直間の検索条件の入力
　　 If kub <> "" Then
　　　　 'セルB2からB列の最終データ行までのデータを対象としてオートフィルタする
　　　　.Range("B2:B" & CE).AutoFilter Field:=2, Criteria1:=kub　'区分の検索条件がなければ無視
　　 End If
【33901】Re:複数の検索条件をクリアーした情報を...
お礼  GREEN  - 06/1/23(月) 16:18 -
引用なし
パスワード
   Statisさんへ

.Rows(2).AutoFilter
この様に書くと、２行目にオートフィルター設定ですか。
よくわかりました。
.Range("B2:B" & CE)
(XX & CE) で、XXからCEまでという意味ですか。これもよくわかりました。

これで今回ご教授して頂いたマクロの意味が理解できました。
本当にありがとうございました。

追伸
条件に合わないとエラーが出るようですが、
これはon error のステートメント（？）を使って、
メッセージボックスが出るようにしたいと思います。
On Error Goto ErrorCheck
　　　　　・
　　　　　・
　　　　　・
ErrorCheck:
　 MsgBox "検索条件に合うＮｏ．は見つかりませんでした。"
【33906】Re:複数の検索条件をクリアーした情報を...
回答  Statis  - 06/1/23(月) 16:53 -
引用なし
パスワード
   こんにちは

こんな感じです。

Dim CT2 As Range, CE As Long, C As Range, Ch As Boolean
Dim kub As String, ttan As String, tyoku As String

With ActiveSheet
　　 CE = .Range("A65536").End(xlUp).Row
　　 If .AutoFilterMode = False Then
　　　　.Rows(2).AutoFilter
　　 End If
　　 Ch = True
　　 kub = Me.ComboBox48.Value　　　'区分の検索条件入力
　　 ttan = Me.ComboBox49.Value　　 '担当者の検索条件入力
　　 tyoku = Me.ComboBox50.Value　　'直間の検索条件の入力
　　 If kub <> "" Then
　　　　.Range("B2:B" & CE).AutoFilter Field:=2, Criteria1:=kub　'区分の検索条件がなければ無視
　　 End If
　　 If ttan <> "" Then
　　　　.Range("C2:C" & CE).AutoFilter Field:=3, Criteria1:=ttan　'同じく、担当者
　　 End If
　　 If tyoku <> "" Then
　　　　.Range("D2:D" & CE).AutoFilter Field:=4, Criteria1:=tyoku '同じく、直間
　　 End If
　　 On Error GoTo ErrorCheck
　　 Set CT2 = .Range("A3:A" & CE).SpecialCells(xlCellTypeVisible)
　　 On Error GoTo 0
　　 Me.ListBox1.Clear
　　 For Each C In CT2
　　　　 Me.ListBox1.AddItem C.Value
　　 Next C
　　 Ch = False
ErrorCheck:
　　 If Ch Then
　　　　MsgBox "検索条件に合うＮｏ．は見つかりませんでした。"
　　 End If
　　 Set CT2 = Nothing
　　 .AutoFilterMode = False
End With
【33911】Re:複数の検索条件をクリアーした情報を...
お礼  GREEN  - 06/1/23(月) 17:13 -
引用なし
パスワード
   Statisさんへ

アフターフォローまでして下さるとは・・・
ありがとうございます。

私が設定した前述のOn Error Goto では、綺麗に変数を初期化していなかった為に
項目に合わない条件検索をした後に、項目に合う条件検索をすると
リストボックスが正常に表示されない状態でした。
（２度、検索を実行すると正常に項目が表示される状態でした）

本当にありがとうございました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
8337 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free