Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
4430 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【56694】オートフィルターのフィルタリング行数について まさ 08/6/30(月) 21:10 質問[未読]
【56695】Re:オートフィルターのフィルタリング行数... ponpon 08/6/30(月) 21:47 発言[未読]
【56698】Re:オートフィルターのフィルタリング行数... n 08/6/30(月) 23:22 発言[未読]
【56706】Re:オートフィルターのフィルタリング行数... まさ 08/7/1(火) 9:36 回答[未読]
【56709】Re:オートフィルターのフィルタリング行数... n 08/7/1(火) 11:42 発言[未読]
【56710】Re:オートフィルターのフィルタリング行数... n 08/7/1(火) 13:03 発言[未読]
【56705】Re:オートフィルターのフィルタリング行数... まさ 08/7/1(火) 9:28 発言[未読]
【56714】Re:オートフィルターのフィルタリング行数... ponpon 08/7/1(火) 19:56 発言[未読]
【56694】オートフィルターのフィルタリング行数に...
質問  まさ  - 08/6/30(月) 21:10 -
引用なし
パスワード
   オードフィルタで絞り込み検索を行った時にフィルタリングにヒットした個数（行数）を取得し、条件分岐させたいのですが、下記のように実装しても動作しません、

　Dim r As Range

　'Selection.AutoFilterにてフィルタリングを実施。

　Set r = ActiveSheet.AutoFilter.Range
　Set r = Intersect(r.Offset(1), r.Columns(1))

　If xlVisible <= 0 Then
　　MsgBox "No"
　Else
　　MsgBox "YES"
　End If

上記のように実装した場合、フィルタリングの個数（行数）に関係なく全て"YES"に入り込むのですが、問題点をご指摘願います。
初心者でもう訳ありませんが、よろしくお願いします。
【56695】Re:オートフィルターのフィルタリング行...
発言  ponpon  - 08/6/30(月) 21:47 -
引用なし
パスワード
   ▼まさ さん：
こうゆうことかな？
違ったらごめんなさい。

>オードフィルタで絞り込み検索を行った時にフィルタリングにヒットした個数（行数）を取得し、条件分岐させたいのですが、下記のように実装しても動作しません、
>
>　Dim r As Range
>
>　'Selection.AutoFilterにてフィルタリングを実施。
>
>　Set r = ActiveSheet.AutoFilter.Range
>　Set r = Intersect(r.Offset(1), r.Columns(1))

　 If r.SpecialCells(xlVisible).Rows.Count <= 0 Then

>　　MsgBox "No"
>　Else
>　　MsgBox "YES"
>　End If
>
【56698】Re:オートフィルターのフィルタリング行...
発言  n  - 08/6/30(月) 23:22 -
引用なし
パスワード
   .SpecialCells(xlVisible) は抽出がない時エラーになります。
また、このケースで抽出件数を得るには.Rows.Countより.Cells.Countのほうが良いと思います。

エラー対策を考慮すると
MsgBox WorksheetFunction.Subtotal(3, ActiveSheet.AutoFilter.Range.Columns(1)) > 1
で良いかと。
【56705】Re:オートフィルターのフィルタリング行...
発言  まさ  - 08/7/1(火) 9:28 -
引用なし
パスワード
   >　If r.SpecialCells(xlVisible).Rows.Count <= 0 Then
上記で実行したところ、フィルタリングにヒットした件数が0件の時に
「実行時エラー'1004':該当するセルが見つかりません」のウィンドウが表示され、うまく処理が行えませんでした。どこに問題があるのか分かりますでしょうか？ネットで調べてみたのですが、分かりませんでした。
【56706】Re:オートフィルターのフィルタリング行...
回答  まさ  - 08/7/1(火) 9:36 -
引用なし
パスワード
   ご回答ありがとうございます。

>エラー対策を考慮すると
>MsgBox WorksheetFunction.Subtotal(3, ActiveSheet.AutoFilter.Range.Columns(1)) > 1
>で良いかと。

If WorksheetFunction.Subtotal(3, ActiveSheet.AutoFilter.Range.Columns(1)) > 1 Then
というif文で分岐させてみたのですが、フィルタリングでヒットした件数が0件の場合も1件以上の場合もこのif文の結果が偽となるようです。どこに問題があるのかご教授願えませんでしょうか？
【56709】Re:オートフィルターのフィルタリング行...
発言  n  - 08/7/1(火) 11:42 -
引用なし
パスワード
   >どこに問題があるのか
MsgBox WorksheetFunction.Subtotal(3, ActiveSheet.AutoFilter.Range.Columns(1))
とか
MsgBox WorksheetFunction.Subtotal(3, ActiveSheet.AutoFilter.Range.Columns(2))
などで確認してください。
抽出結果範囲の最左列が空白セルなのでは。
【56710】Re:オートフィルターのフィルタリング行...
発言  n  - 08/7/1(火) 13:03 -
引用なし
パスワード
   補足。
MsgBox ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
#...でも良いとは思いますが、SpecialCellsは不連続範囲数約8,000くらいまでという制限あるそうです。
#しかもなんか遅いし。

Sub test()
　　MsgBox afCount(ActiveSheet)
End Sub

Function afCount(ws As Worksheet)
　　Dim r　 As Range
　　Dim ret

　　On Error GoTo errH
　　Set r = ws.AutoFilter.Range
　　Set r = r.SpecialCells(xlCellTypeVisible)
　　ret = CLng(r.Count) - 1
　　Set r = Nothing
errH:
　　If Err.Number <> 0 Then ret = Err.Number & ":" & Err.Description
　　Set r = Nothing
　　afCount = ret
End Function
【56714】Re:オートフィルターのフィルタリング行...
発言  ponpon  - 08/7/1(火) 19:56 -
引用なし
パスワード
   ▼まさ さん：
>>　If r.SpecialCells(xlVisible).Rows.Count <= 0 Then
>上記で実行したところ、フィルタリングにヒットした件数が0件の時に
>「実行時エラー'1004':該当するセルが見つかりません」のウィンドウが表示され、うまく処理が行えませんでした。

nさんが、すでに回答しているので、私のようなものが答えるのはどうかと思いますが、SpecialCellsは、そのセルが見つからないときはエラーが出ます。
普通Autofilterは、項目行があるのでエラーにはならないのですが、今回は
Offset(1)しているので、0件の時にエラーになるのだと思います。
　ですから、ｎさんの回答で進めてください。
　失礼しました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
4430 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free