質問をみてくださりありがとうございます。
Excelの一覧表から、様々なフィルタ条件によって件数を拾うマクロを作成したのですが、
うまく件数を拾ってくれず、
最初の1行目は件数を拾いますが、
あと2行目からは1行目の件数をそのまま持ってきているかのようになっていて、
明らかに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