VBAの質問（続きです。）

Question

昨日は、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


何度も、すみませんが、よろしくお願いします。

taocat · Accepted Answer

再度こんばんは。
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 · Answer

こんばんは。

＞「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を入れただけです。

以上です。

KenKen_SP · Answer

既に回答がなされていますが、ちょっと視点を変えて見たいと思います。
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

taocat · Answer

こんばんは。
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は抽出結果の画面が出たあと表示されると思います。
以上です。

AloneAgain · Answer

こんにちは。

次のようにしてみてください。
---------------------------
↓の変数を追加
Dim cntKensu As Long


↓を End With の次に追加
------------------------
cntKensu = Sheets("Sheet2").UsedRange.Rows.Count
If cntKensu > 1 Then
   MsgBox cntKensu - 1 & "件 抽出しました。"
Else
   MsgBox "条件に一致するデータはありませんでした。"
End If

VBAの質問（続きです。）

再度こんばんは。

こんばんは。

この回答への補足

既に回答がなされていますが、ちょっと視点を変えて見たいと思います。

こんばんは。

この回答への補足

こんにちは。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング