VBAの質問（続きです。）

質問

昨日は、KenKen_SPさんやtaocatさんには、すばやい対応本当にありがとうございました。お陰様で無事解決しました。ところが、実は、うっかりしていまして、あと１つ重要な点をお伺いするのを忘れてしまいました。そこで、もうひとつだけ何卒教えて下さい。
それは、抽出した件数を、MSGBOXで「○○件ありました。」とか表示させたいのですが、因みに、昨日お世話になったVBAは、次のとおりです。

Sub ParamOutputData()

Dim strKeyword As String
Dim strJouken As String

strKeyword = InputBox("検索したい住所の一部を　　入力してください。")
If strKeyword = "" Then Exit Sub
strJouken = "*" & strKeyword & "*"

Application.ScreenUpdating = False
Sheets("Sheet2").Activate
Cells.Clear

With Sheets("Sheet1")
.Range("A3").AutoFilter Field:=4, _
Criteria1:=strJouken

.Range("A3").CurrentRegion.Copy _
Destination:=Sheets("Sheet2").Range("A3")

.Range("A3").AutoFilter
End With

Sheets("Sheet2").Columns("A:F").AutoFit
Application.ScreenUpdating = True

End Sub

何度も、すみませんが、よろしくお願いします。

回答No.5

taocat · ベストアンサー

再度こんばんは。
No.1,AloneAgainさんの回答がまさにそれです。
最初の質問の回答は、No.1AloneAgainさんの回答でよかったのですが、MsgBoxをScreenUpdate=Trueの前に入れるのか、後に入れるのかで見た目が違いますよ、と言いたかったのが当方の回答でした。

Application.ScreenUpdating = True
------------------------------------------------
　Dim Kensu As Long
　Kensu=Range("A3").CurrentRegion.Rows.Count - 1
　If Kensu = 0 Then
　　MsgBox "該当住所はありません、残念っ！"
　Else
　　MsgBox "抽出件数：" & Kensu & " 件"
　End If
----------------------------------------------
End Sub

以上です。

お礼

taocatさんへ

If Kensu = 0 Then
　　MsgBox "該当住所はありません、残念っ！"
　Else

　以上大変よく分かりました。いろいろご親切に、しかも何度もご丁寧に有り難うございました。
　これからも、何か分からない点がありましたら、どうか、嫌がらないで教えて下さい。

回答No.4

taocat

こんばんは。

＞「Rows.Count - 1」という式ですが、この「－１」は、どういう意味を持っているのでしょうか

Range("A3").CurrentRegion.Rows.Countで抽出行を求められますが、それには見出し行もカウントされてますので、１を引いているわけです。

＞２番目のApplication.ScreenUpdating = True
MsgBox "抽出件数：" & Range("A3").CurrentRegion.Rows.Count - 1 & " 件"
だけでなく、２つ行う理由はどうしてか

ちょっと質問の意味が掴めません・・(^^;;;

con-conさんのコードは以下のようになってますよね。
-----------------------------------------
End With

Sheets("Sheet2").Columns("A:F").AutoFit
▲
Application.ScreenUpdating = True
●
End Sub
------------------------------------------------

回答では、▲と●の所にMsgBoxを入れてるわけですが、これはそこ２箇所にMsgBoxを入れる、ということではありません。
入れるのは▲か●のどちらか一方です。
が、先の回答にも書きましたが、sheet1をアクティブにしてマクロを実行すると▲●のどちらにMsgBoxを入れるかで見た目が変わるので、それを確認してもらうために▲●２箇所に同じMsgBoxを入れただけです。

以上です。

補足

taocatさんへ

両方でなくどちらかの後へ入れるという意味が、分かりました。それで、おっしゃるように、Application.ScreenUpdating = Trueの後へ入れてみましたら、「抽出：何件」という表示が出ました。本当に、嬉しかったです。ありがとうございました。それで、厚かましいですが、もう１つ、よろしいでしょうか。実は、今、気が付いたんですが、もし、検索して該当件数が０件の時は、「該当なし」とか「一致するものがない」とかの表示もできるんでしょうか。本当に虫がいいとは思いますが、何卒、よろしくお願いします。
すみませんです。

回答No.3

KenKen_SP

既に回答がなされていますが、ちょっと視点を変えて見たいと思います。
CurrentRegion や UsedRange は注意して使う必要があります。

今回は転記先となるSheet2が

Sheets("Sheet2").Activate
Cells.Clear

で予め初期化されておりますので、転記されたシートのデータ範囲を CurrentRegion や UsedRange で取得し、その行数－（見出し行数）で該当レコード数を求めることができます。#1および#2の方の方法がこれですね。

ただし、CurrentRegion や UsedRange はその特性をよく理解して使わないと思いがけないデータ範囲を返します。例えば、今回の場合ですと

With Sheets("Sheet1")
　　Sheets("Sheet2").Range("A2").Value="検索結果"
　　.Range("A3").AutoFilter Field:=4, Criteria1:=strJouken
　　.Range("A3").CurrentRegion.Copy _
　　Destination:=Sheets("Sheet2").Range("A3")
　　.Range("A3").AutoFilter
End With

とすると、A2セルもデータ範囲としてカウントされてしまいます。

そこで、VBA学習の初期の方は混乱するかもしれませんが、AutoFilter オブジェクトのRangeメソッドを利用します。

Sheets("Sheet1").Autofilter.Range.Rows.Count - 1

でシート1でオートフィルターが設定されたデータ範囲の全レコードを取得できます。また、抽出データ数を正しく取得するためには、CurrentRegion や UsedRange を注意深く使うか、可視セルの行数をループでカウントするしかありません。

以下のコードはオートフィルターの抽出データ数取得を関数化してみました。
オリジナルコードにも少々手を入れています。ご参考までに。

Sub ParamOutputData()

　　Dim strKeyword As String
　　Dim strJouken　As String
　　Dim lTotalCnt As Long
　　Dim lFilterCnt As Long
　　Dim strMes As String

　　'検索条件作成
　　strKeyword = InputBox( _
　　　　Prompt:="検索したい住所の一部を入力してください。", _
　　　　Title:="データ検索")
　　If strKeyword = "" Then Exit Sub
　　strJouken = "*" & strKeyword & "*"

　　'データ抽出
　　With Sheets("Sheet1")
　　　　'オートフィルター作成
　　　　.Range("A3").AutoFilter Field:=4, Criteria1:=strJouken
　　　　'データ総件数（＝関数の戻値-見出1行分）
　　　　lTotalCnt = GetFilterRecordCnt(.Name, True) - 1
　　　　'抽出データ数（＝関数の戻値-見出1行分）
　　　　lFilterCnt = GetFilterRecordCnt(.Name, False) - 1
　　　　'抽出データ数で処理分岐
　　　　If lFilterCnt > 0 Then
　　　　　　Application.ScreenUpdating = False
　　　　　　'転記先初期化
　　　　　　Sheets("Sheet2").Activate
　　　　　　Cells.Clear
　　　　　　'抽出データコピー
　　　　　　.AutoFilter.Range.SpecialCells(xlCellTypeVisible) _
　　　　　　　　.Copy Destination:=Sheets("Sheet2").Range("A3")
　　　　　　'列幅修正
　　　　　　Sheets("Sheet2").Columns("A:F").AutoFit
　　　　　　'結果報告メッセージ生成
　　　　　　strMes = lTotalCnt & " 件中 " & _
　　　　　　　　　　 lFilterCnt & "件のレコードがヒットしました"
　　　　Else
　　　　　　'結果報告メッセージ生成
　　　　　　strMes = "該当するレコードはありません"
　　　　End If
　　　　'オートフィルター解除
　　　　.Range("A3").AutoFilter
　　　　Application.ScreenUpdating = True
　　End With

　　MsgBox strMes, vbInformation, "検索結果"

End Sub

'フィルタで抽出したレコード数取得関数
'引数:strSheetName シート名（文字列）
'引数:TotalRocord　Trueだと総レコード数取得
Function GetFilterRecordCnt( _
　　strSheetName As String, _
　　Optional TotalRocord As Boolean = False) As Variant

　　Dim lngCnt As Long
　　Dim FilterRng As Range, FilterCol As Range, VisiblRng As Range
　　Dim rngCurrent As Range

　　On Error GoTo ErrorHandler
　　lngCnt = 0
　　Set FilterRng = Sheets(strSheetName).AutoFilter.Range
　　Set FilterCol = FilterRng.Columns(FilterRng.Column)
　　Set VisiblRng = FilterRng.SpecialCells(xlCellTypeVisible)
　　For Each rngCurrent In Intersect(VisiblRng, FilterCol)
　　　　lngCnt = lngCnt + 1
　　Next rngCurrent

　　If TotalRocord Then
　　　　GetFilterRecordCnt = FilterRng.Rows.Count
　　Else
　　　　GetFilterRecordCnt = lngCnt
　　End If

ExitHandler:
　　Set VisiblRng = Nothing
　　Set FilterCol = Nothing
　　Set FilterRng = Nothing
　　Exit Function
ErrorHandler:
　　GetFilterRecordCntCnt = "ERR:フィルタがありません"
　　Resume ExitHandler

End Function

お礼

KenKen_SPさんへ
今回もありがとうございます。
おかげ様で、助かりました。
それに、貴重な時間を割いて、いろいろご指導
ありがとうございます。本当に嬉しいです。

回答No.2

taocat

こんばんは。
Msgboxの表示は、最後の
Application.ScreenUpdating = True
の後がベターだと思います。

MsgBoxを下記の位置に２つ入れて試してみて下さい。
----------------------------------------------

Sheets("Sheet2").Columns("A:F").AutoFit

MsgBox "抽出件数：" & Range("A3").CurrentRegion.Rows.Count - 1 & " 件"

Application.ScreenUpdating = True

MsgBox "抽出件数：" & Range("A3").CurrentRegion.Rows.Count - 1 & " 件"

End Sub
---------------------------------------------

ひとつめのMsgBoxは画面が何も変化しない状態で表示され、
後のMsgBoxは抽出結果の画面が出たあと表示されると思います。
以上です。

お礼

taocatさんへ

con-conです。いろいろ有り難うございました。
私も、早く皆さんの領域に１歩でも近づけるように、
研鑽を重ね、頑張りたいという思いを、改めて強く
胸に刻みました。今後との、是非ともよろしくご指導
お願いします。

補足

taocatさんへ

お陰様で、うまくいきました。ありがとうございました。さて、上記の回答の中で、「Rows.Count - 1」という式ですが、この「－１」は、どういう意味を持っているのでしょうか。すみません。よろしくお願いします。また、２番目の
Application.ScreenUpdating = True

MsgBox "抽出件数：" & Range("A3").CurrentRegion.Rows.Count - 1 & " 件"
だけでなく、２つ行う理由はどうしてか教えて下さい。いろいろ申し訳ありません。

回答No.1

AloneAgain

こんにちは。

次のようにしてみてください。
---------------------------
↓の変数を追加
Dim cntKensu As Long

↓を End With の次に追加
------------------------
cntKensu = Sheets("Sheet2").UsedRange.Rows.Count
If cntKensu > 1 Then
MsgBox cntKensu - 1 & "件 抽出しました。"
Else
MsgBox "条件に一致するデータはありませんでした。"
End If

お礼

はじめまして、
お返事が遅くなりまして、すみませんです。
ご親切に、回答下さいまして、ありがとうございます。
cntKensuは、はじめて知りました。参考になりました。今後とも、どうぞよろしくお願いします。
助かりました。