【VBA】表の指定した列で各データにて絞り込んで、絞り込まれたデータ別の合計値を取得する

VBAで
 ・表の指定した列で各データにて絞り込んで

 ・絞り込まれたデータ別の合計値を取得
できます!

「佐藤」の売上の合計値は「120」、「鈴木」は「150」」、「鈴木」は「180」
「佐藤」の売上の合計値は「120」、「鈴木」は「150」、「田中」は「180」
データ別の合計値を取得
データ別の合計値を取得


VBAで
 ・表をテーブル化
 ・絞り込み用の「重複しないリスト」を取得
 ・オートフィルタでデータの絞り込み
 ・絞り込んだデータの合計値を取得
 ・テーブル化の解除
の実施により実現します!
※一時的にテーブル化することで、シンプルなコードにできます。

PR

VBAコード

ここでは例として、
 ・シート「data」上の表をテーブル化
 ・列「名前」から「重複しないリスト」を取得
 ・列「名前」を「重複しないリストの各データ」で絞り込み
 ・列「売上」のデータ別の合計値を取得
 ・テーブル化を解除
します。
※取得した合計値をイミディエイトウィンドウへ出力します。

「佐藤」の売上の合計値は「120」、「鈴木」は「150」、「鈴木」は「180」
「佐藤」の売上の合計値は「120」、「鈴木」は「150」、「田中」は「180」
Option Explicit

Sub sample()

    Dim ws As Worksheet
    Dim startRange  As Range
    Dim filterColumnName As String
    Dim totalColumnName As String
    Dim table As ListObject
    Dim filterdRange As Range
    Dim filterValue As Variant
    Dim total As Long
    Dim dicResult As Object
    Dim key As Variant

    '対象シート
    Set ws = Worksheets("data")
    '表の一番左上のセル
    Set startRange = ws.Range("B2")
    'フィルタ対象の列名
    filterColumnName = "名前"
    '集計対象の列名
    totalColumnName = "売上"
    
    '表をテーブル化してListObjectを取得
    Set table = ws.listObjects.Add(Source:=startRange.CurrentRegion, XlListObjectHasHeaders:=xlYes)
    '「フィルタ対象の列」にて重複しないように絞り込み
    table.ListColumns(filterColumnName).Range.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    '絞り込んだ範囲を取得 ※絞り込み用の「重複しないリスト」を取得
    Set filterdRange = table.ListColumns(filterColumnName).DataBodyRange.SpecialCells(xlCellTypeVisible)
    
    '絞り込みを解除
    If ws.FilterMode Then
        ws.ShowAllData
    End If
    
    Set dicResult = CreateObject("Scripting.Dictionary")
    
    '「重複しないリストの要素の数」だけ繰り返し
    For Each filterValue In filterdRange.Value
        '「フィルタ対象の列」」で絞り込み
        startRange.AutoFilter field:=table.ListColumns(filterColumnName).Index, Criteria1:=filterValue
        '「集計対象の列」の「絞り込まれたデータの合計値」を取得
        total = WorksheetFunction.Subtotal(9, table.ListColumns(totalColumnName).DataBodyRange)
        '「フィルタした文字列」と「合計値」のペアをDictionaryへ追加
        dicResult.Add filterValue, total
    Next

    'テーブル化を解除
    With table
        .TableStyle = ""
        .Unlist
    End With
    
    '「Dictionaryの要素の数」だけ繰り返し
    For Each key In dicResult.Keys
        '結果をイミディエイトウィンドウへ出力
        Debug.Print key & ":" & dicResult(key)
    Next
    
End Sub

以下を指定します(17~23行目)。
※状況に応じて任意の値を指定してください。

・対象シート
・表の一番左上のセル
・フィルタ対象の列名
・集計対象の列名

「Rangeオブジェクト」の「AdvancedFilter」メソッドにより、「重複しないように絞り込み」をします(28行目)。
※「Action」に「xlFilterInPlace」、「Unique」に「True」を指定します。

PR

実行結果

表の指定した列で各データにて絞り込んで、絞り込まれたデータ別の合計値を取得できました。
※「佐藤」の売上の合計値「120」、「鈴木」は「150」、「田中」は「180」を取得できました。
※結果をイミディエイトウィンドウへ出力できました。

実行結果
実行結果
PR

参考①

上記のVBAコードは以下の記事を参考にして作成しました。

●重複を除いたリスト(Dictionary)を作成する


●表の指定した列でデータを絞り込んで、絞り込まれたデータの合計値を取得する

PR

参考②

本記事の内容は
 ・いただいた問い合わせを参考にして作成
しました。