質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.46%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

2回答

1327閲覧

ExcelVBA 担当者別に複数フィルタしたデータの件数を拾いたい。

waiwaicommons

総合スコア0

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

0クリップ

投稿2021/05/23 16:19

編集2021/05/23 16:23

質問をみてくださりありがとうございます。
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

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

jinoji

2021/05/24 03:58

質問の編集で、 コード部分の先頭と最後にそれぞれ「```」を1行つけると、 コードが読みやすく表示されます。 (質問編集画面の「コードの挿入」というアイコンメニューでも同じことができます)
guest

回答2

0

推測のひとつでしかありませんが、データが多くて動きが重く、2つめのAutoFilterがかかる前にSubtotalが走ってしまうとか・・・
そういう場合は、2つめのAutoFilterのあと、SubtotalのまえにDoEventsを挟んでみるとか、私は
推測でそういうことを試すこともあります。
また、トラブルとは直接関係ない話で恐縮ですが、AutoFilterを付けたり外したりしていますが、AutoFilterを付けっぱなしでもwsSheet.ShowAllDataでフィルターを解除するという方法もあるかと思います。
また、フィルターでSubTotalをしかもマクロでというのは、なかなか特殊な方法かと思いました。COUNTIFSなどの関数でやったほうが、楽な気がします。

投稿2021/05/26 11:32

plomte

総合スコア46

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

0

まず以下を試してみてください。

VBA

1times = WorksheetFunction.Subtotal(3, wsSheet.AutoFilter.Range.Columns(3)) '担当列の結果を抽出する 2

投稿2021/05/23 23:28

jinoji

総合スコア4585

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

まだベストアンサーが選ばれていません

会員登録して回答してみよう

アカウントをお持ちの方は

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.46%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問