ExcelVBA 担当者別にフィルタして抽出した件数をセルに記入したい。 質問をみてくださりありがと

ExcelVBA 担当者別にフィルタして抽出した件数をセルに記入したい。

質問をみてくださりありがとうございます。
一覧表から、様々なフィルタ条件によって件数を拾うマクロを作成したのですが、
うまく件数を拾ってくれず、明らかに0件な場所でも件数が上がってしまいます。
初心者なもので見直しても、何がいけないのかわからず。。

どうかお知恵を貸してください。
自分がわかりやすいようにコードにコメントが多いのですが、
邪魔に見えたらすみません。
よろしくお願いします。

○やりたいこと
担当者別にフィルタを行い、以下6点の件数を拾っています。

担当者別での
1、全件数　
2、完了件数　　：完了日列に値が入っている件数
3、期日超過件数　　：期日列の日付が基準日セルより過ぎており、完了日列が空白になっている件数
4、先週分発生件数　　：特定期間の発見日の件数
5、先週分完了件数　　：特定期間の完了日の件数
6、残件数　　：完了日が空白の件数

Option Explicit

Sub フィルタ集計()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim wsBook As Workbook '参照ブック
Dim wsSheet As Worksheet '参照するブックのワークシート "一覧表"
Dim maxRow As String '参照ブックの最終行
Dim Cs As Worksheet '記入を行うこのワークシート "件数表"
Dim targetDateFrom As Date ' 先週開始日
Dim targetDateTo As Date ' 検索終了日(yyyy/m/d で入力する想定)
Dim refDate As Date '超過の基準日
Dim times As Long 'カウント用
Dim PersonNm As String '担当列
Dim Csrow As Long '件数表の行　9-13行目

Set wsBook = Workbooks.Open(ThisWorkbook.Path & "\" & "担当一覧表.xlsx")
Set wsSheet = wsBook.Worksheets("ワークシート")

maxRow = wsSheet.Cells(Rows.Count, "B").End(xlUp).Row '一覧表のB列最終行

ThisWorkbook.Activate
Set Cs = ThisWorkbook.Worksheets("件数表")

'集計領域をクリアする　（E9からQの12まで）
Cs.Range(Cs.Cells(9, 5), Cs.Cells(12, 10)).Value = ""

'件数表の担当列を把握
For Csrow = 9 To 12 '記入シートの担当列9行目～12行目

'●全件数：担当列をフィルタして全件数を取得--------------------
PersonNm = Cs.Range("B" & Csrow).Value '件数表の担当列
wsSheet.Range("A4").AutoFilter 3, "*" &PersonNm & "*" '

times = WorksheetFunction.Subtotal(3, Columns(3)) '担当列の結果を抽出する
Cs.Cells(Csrow, 5).Value = times - 1
wsSheet.Range("A4").AutoFilter

'●完了件数：担当列をフィルタ、完了日に値が入っているものフィルタ表示("空白セル以外")
wsSheet.Range("A4").AutoFilter 3, "*" & PersonNm & "*"
wsSheet.Range("A4").AutoFilter 6, Criteria1:=" <>" '空白以外(値がある)セルをフィルタ

times = WorksheetFunction.Subtotal(3, Columns(3))
Cs.Cells(Csrow, 6).Value = times - 1
wsSheet.Range("A4").AutoFilter

'●超過件数：担当列をフィルタ、期日が基準日セルより前の日付のみフィルタ表示
wsSheet.Range("A4").AutoFilter 3, "*" & PersonNm & "*"

refDate = CDate(Cs.Range("G3")) '基準日を変数に格納
wsSheet.Range("A4").AutoFilter 5, "< " & refDate

times = WorksheetFunction.Subtotal(3, Columns(3)) '絞り込まれた担当列の抽出データを集計
Cs.Cells(Csrow, 7).Value = times - 1
wsSheet.Range("A4").AutoFilter


'●先週分発生：担当列をフィルタ、特定期間に当てはまっている記述日をフィルタ
wsSheet.Range("A4").AutoFilter 3, "*" & PersonNm & "*"

targetDateFrom = CDate(Cs.Range("F3")) '開始日
targetDateTo = CDate(Cs.Range("F5")) '終了日
wsSheet.Range("A4").AutoFilter 2, ">=" & targetDateFrom, xlAnd, "<= " & targetDateTo

times = WorksheetFunction.Subtotal(3, Columns(3)) '記述日列を特定期間で絞りこみ、抽出された担当列のデータ個数を集計
Cs.Cells(Csrow, 8).Value = times - 1
wsSheet.Range("A4").AutoFilter


'●先週分完了：担当列をフィルタ、特定期間にあてはまっている完了日のみをフィルタ
wsSheet.Range("A4").AutoFilter 3, "*" & PersonNm & "*" '一覧表の担当列をフィルタ
wsSheet.Range("A4").AutoFilter 6, ">=" & targetDateFrom, xlAnd, "<= " & targetDateTo '特定期間でフィルタ

times = WorksheetFunction.Subtotal(3, Columns(3)) '完了日列を特定期間で絞込み、抽出された担当列のデータ個数を集計
Cs.Cells(Csrow, 9).Value = times - 1
wsSheet.Range("A4").AutoFilter


'●残件数：担当列をフィルタ、完了日付が入っていないもののみフィルタ
wsSheet.Range("A4").AutoFilter 3, "*" & PersonNm & "*"
wsSheet.Range("A3").AutoFilter 6, Criteria1:="="

times = WorksheetFunction.Subtotal(3, Columns(3))
Cs.Cells(Csrow, 10).Value = times - 1
wsSheet.Range("A4").AutoFilter


Next Csrow

'フィルタをかけておく。
With wsSheet
If .AutoFilterMode = False Then
.Range("A4").AutoFilter
End If

End With

MsgBox ("完了")

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

質問者からの補足コメント

• 一覧表のイメージ図です

  
    補足日時：2021/05/24 00:48

No.6 ベストアンサー 回答者： Qchan1962 回答日時： 2021/05/28 14:11

こんにちは

閉じられていなかったので、どうなりましたでしょうか
前回、寝ぼけ半分で回答してしまったので改めて回答します

いきなりwsSheet.Activateはエラーかな
申し訳ないです。

＞明らかに0件な場所でも件数が上がってしまいます。
＞初心者なもので見直しても、何がいけないのかわからず。。

times = WorksheetFunction.Subtotal(3, Columns(3))　が正しく計算されない為です。
Columns(3)のシートオブジェクトは　ActiveSheetが省略されていますので
Subtotal(3, Columns(3))は　ThisWorkbook.Activateとなっている為
担当一覧表.xlsxのWorksheets("ワークシート")又はアクティブなシートで計算されています。

これを回避するためには、色々方法はありますが、この場合、処理の順番を変えれば良いです。

順番を変える例

ThisWorkbook.Activate　実行の初めなので不要です（すでにアクティブになっている為）

Set Cs = ThisWorkbook.Worksheets("件数表")

'集計領域をクリアする　（E9からQの12まで）
Cs.Range(Cs.Cells(9, 5), Cs.Cells(12, 10)).Value = ""

Set wsBook = Workbooks.Open(ThisWorkbook.Path & "\" & "担当一覧表.xlsx")
開いたブックがアクティブになります

Set wsSheet = wsBook.Worksheets("ワークシート")
wsSheet.Activate　’念のため
maxRow = wsSheet.Cells(Rows.Count, "B").End(xlUp).Row '一覧表のB列最終行

これでSubtotal(3, Columns(3))はWorksheets("ワークシート")で計算されます。

'件数表の担当列を把握　以下同じ　＃４の修正は必要かと

フィルタの第2カラム条件は全体のフィルタを解除しなくとも
設定、解除が出来ますので少し纏める事が出来ると思います。
これはまた、別の話ですね

No.5 回答者： Qchan1962 回答日時： 2021/05/25 01:57

連投すみません

寝る前に読み返していて気が付いた点を
多分、フィルタ側のシートがアクティブになっていない為かも知れません。

wsSheet.Activate
For Csrow = 9 To 12 '記入シートの担当列9行目～12行目

No.4 回答者： Qchan1962 回答日時： 2021/05/24 23:57

#3です

wsSheet.Range("A4").AutoFilter 3, "*" & PersonNm & "*"
wsSheet.Range("A3").AutoFilter 6, Criteria1:="="
A3？　タイプミス？

No.3 回答者： Qchan1962 回答日時： 2021/05/24 23:40

こんばんは

ぱっと見でコードを実行して試した訳でないので違うかもですが、
times変数を使い廻しているようですが、値取得（変数代入）は必ず行われるのでしょうか？　まあ、出来そうですけれどステップ実行などで確認しながら検証してみてはいかがでしょう。

他のブックを開いているようなので中断できませんと叱られるかもしれませんが、OKで無視して確認してください。

書き方は人それぞれ好みもあると思いますが、実行部分や出力部分を纏められるとわかり易いかもと思いました。

No.2 回答者： 高木さんWIN 回答日時： 2021/05/24 21:45

何となくですけど。

COUNTIFやCOUNTIFS関数で出来るのではないの？と感じました。

でも一覧表のＣ５のような書き方は本来しない方が良いですけどね。

No.1 回答者： めぐみん_ 回答日時： 2021/05/24 06:40

https://akira55.com/advancedfilter/

中段辺りの
『EXCEL VBA AdvancedFilterメゾット　指定した複数条件でのデータ抽出（別シートに結果を表示）』

項目名を統一すれば比較的楽に出来ると思いますよ。

この回答へのお礼

回答ありがとうございます。
すみません初心者なもので、理解が及ばず…。
「項目名を統一」の具体的な意味を教えていただけないでしょうか

お礼日時：2021/05/24 08:20