【EXCEL VBA（マクロ）】指定した範囲のデータをカウント・合計する

SUBTOTALとは

VBAのSUBTOTAL関数は、指定されたデータ範囲内のデータに対して、指定された集計関数を適用し、集計結果を返す関数です。SUBTOTAL関数は、データの階層化やフィルタリングが行われている場合でも正確な集計結果を得ることができます。

構文：SUBTOTAL（集計方法,範囲）

＜集計方法＞

平均：1
数値の個数：2
データの個数：3
最大値：4
最小値：5
合計：9

カウントと合計

ExcelのアクティブシートのC列にある数値データの件数と合計を計算し、それらの値をカウントシートのB2、B3セルに表示するコードです。

Sub カウントと合計()

Dim 件数 As Long
Dim 合計 As Long

件数 = 0
件数 = WorksheetFunction.Subtotal(2, ActiveSheet.Range("C:C"))

合計 = 0
合計 = WorksheetFunction.Subtotal(9, ActiveSheet.Range("C:C"))

Worksheets("カウント").Range("B2").Value = 件数 & "件"
Worksheets("カウント").Range("B3").Value = 合計
Worksheets("カウント").Select

With ActiveWorkbook
        .NewWindow
        Windows.Arrange ArrangeStyle:=xlArrangeStyleCascade
    
        Dim window1 As Window
        Set window1 = ActiveWindow
        window1.Width = 400
        window1.Height = 400
        
        Sheets("カウント").Select
End With

MsgBox "完了"
End Sub

解説

件数と合計を保存する変数件数と合計を宣言します。
WorksheetFunction.Subtotal関数を使用してアクティブシートのC列の件数と合計を計算し、変数に代入します。
計算した件数と合計をカウントシートのB2、B3セルに表示します。
ワークブックを新しいウィンドウで開き、カウントシートを選択します。
ウィンドウのサイズを設定します。
最後に、メッセージボックスを表示して処理を終了します。

※WorksheetFunction.Subtotal関数は、引数で指定した関数の計算結果を返す関数であり、第1引数で計算する関数を指定します。2はカウントを表し、9は合計を表します。上記のコードでは、それぞれの関数でC列の値を計算しています。

また、新しいウィンドウを開くためにNewWindowメソッドを使用し、ウィンドウのサイズを設定するためにWidthとHeightプロパティを使用しています。

最後に、メッセージボックスを表示して処理が完了したことをユーザーに知らせています。

カウント・Subtotal

Sub カウント()
'Range(“A1″).AutoFilter Field:=3, Criteria1:=”=”'←空欄　”<>”空欄でない

'基ファイル
Dim wb1 As Workbook
Set wb1 = ThisWorkbook
Dim ws1 As Worksheet
Set ws1 = ActiveSheet
Dim LastRow1 As Long
LastRow1 = ws1.Cells(Rows.Count, 2).End(xlUp).Row

'抽出条件①(A列～D列)
Dim 受注件数1 As Long
Dim 受注個数1 As Long
Dim 出荷件数1 As Long
Dim 出荷個数1 As Long

ws1.Activate

ws1.Range("C32").CurrentRegion.AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=ws1.Range("A1:D2"), _
Unique:=False

受注件数1 = WorksheetFunction.Subtotal(3, Range("T32:T" & Cells(Rows.Count, "T").End(xlUp).Row)) - 1
ws1.Cells(6, "D").Value = 受注件数1

受注個数1 = WorksheetFunction.Subtotal(9, Range("X32:X" & Cells(Rows.Count, "X").End(xlUp).Row))
ws1.Cells(7, "D").Value = 受注個数1

出荷件数1 = WorksheetFunction.Subtotal(3, Range("AA32:AA" & Cells(Rows.Count, "AA").End(xlUp).Row)) - 1
ws1.Cells(8, "D").Value = 出荷件数1

出荷個数1 = WorksheetFunction.Subtotal(9, Range("Y32:Y" & Cells(Rows.Count, "Y").End(xlUp).Row))
ws1.Cells(9, "D").Value = 出荷個数1

ws1.Cells(11, "D").Value = ws1.Cells(7, "D").Value * 3000
ws1.Cells(13, "D").Value = ws1.Cells(9, "D").Value * 2000
ws1.Cells(14, "D").Value = ws1.Cells(8, "D").Value * 1000
ws1.Cells(15, "D").Value = ws1.Cells(8, "D").Value * 500
ws1.Cells(12, "D").Value = ws1.Cells(13, "D").Value + ws1.Cells(14, "D").Value + ws1.Cells(15, "D").Value
ws1.Cells(16, "D").Value = ws1.Cells(11, "D").Value - ws1.Cells(12, "D").Value

'カウント計上日（T列）ﾌﾞﾗﾝｸ数
Dim cnt10 As Long
cnt10 = WorksheetFunction.CountBlank(ws1.Range("T33:T" & Cells(Rows.Count, 20).End(xlUp).Row))
ws1.Cells(19, "D").Value = cnt10

'カウント計上日（Z列）「×」数
Dim 不一致件数1 As Long
Range("A32").AutoFilter Field:=26, Criteria1:="×"
不一致件数1 = WorksheetFunction.Subtotal(3, Range("Z32:Z" & Cells(Rows.Count, "Z").End(xlUp).Row))
ws1.Cells(20, "D").Value = 不一致件数1

'フィルタ解除
If ws1.FilterMode Then
 ws1.ShowAllData
End If

MsgBox "完了 "
End Sub