サイト内検索

VBAで売上データから日付別と店員別商品別にクロス集計をする

2020-04-20

VBAで売上データから2つのクロス集計表を作成します。1つ目のクロス集計表は、各店員別に各商品の販売数量と売上が分析できる集計表です。2つ目のクロス集計表は、当月の日別売上高と日別値引額を分析できる集計表です。

まずは、本記事で使用するサンプルファイルの紹介と、VBAコードを実行している1分動画（音声無し）を用意しましたので、宜しければご覧ください。

本記事でご紹介するサンプルファイルとVBAサンプルコードの実演

売上レコードと2つのクロス集計表からなるサンプルファイル

VBAサンプルコードの実行結果を確認するためのダウンロード用ファイルのご紹介です。実際にサンプルファイルをダウンロードしたあとに、標準モジュールを挿入してから、後ほどご紹介するVBAサンプルコードを転記してご利用ください。

VBAサンプルコードの実行結果を実際のExcelシート上で確認できます。

Tips
標準モジュールの挿入方法

ダウンロード用サンプルファイル

実際にVBAサンプルコードを標準モジュールに転記してから、実行させて確認できるダウンロード用ファイルです。

VBA_Sample_File_No7592 ダウンロード

サンプルファイルの各シートについて

サンプルファイルを構成しているシートについて解説します。

「売上データ」シート

「売上データ」シートには、集計元になる対象レコードが入力されています。項目は、「伝票番号」、「日付」、「販売担当者」、「商品①」～「商品⑤」までの各「品名」と「個数」、「値引額」です。

1伝票ごとに一人の店員について、最大5個の商品の販売記録を入力可能です。また1伝票は1回の売買に相当しており、最終列には1回の取引における「値引額」を入力することができます。

「商品別店員別売上詳細」シート

「商品別店員別売上詳細」シートには、5人の販売店員別に各商品を何個売上たかを分析できるクロス集計表が入力されています。さらに、各店員がそれぞれいくら値引したかも集計しています。

また、このクロス集計表は、商品の一覧も兼ねており、その商品名の横には売価が入力されています。

「日付別売上表」シート

「日付別売上表」シートには、ひと月分の日別売上高を、値引額を内訳として集計でいるクロス集計表です。項目は、「商品売上」（値引額除く）、「値引額」、「売上合計」（値引き込み）です。

そして最後の行には、それぞれの項目を月の合計として算出して表示します。

売上レコードを2つのクロス集計表へ集計させるVBAサンプルコード

「売上データ」シートにある集計元レコードのデータを読み取り、2つのクロス集計表へ同時に集計させるVBAサンプルコードをご紹介します。

Option Explicit
    Dim rngFrut As Range        '商品一覧
    Dim r As Long
    Dim c As Long

'■本サンプルコードのメインプログラム
Sub 売上集計()
    Dim curSale As Currency     '1伝票ごとの売上
    Dim datDate As Date         '処理中レコードの伝票日付
    Dim strName As String       '処理中レコードの担当者名
    Dim curVgen As Currency     '処理中レコードの値引額
    
    Dim strFrut As String       '処理中レコードの商品名
    Dim intQty As Integer       '処理中レコードの販売数量
    
    Dim lngERow As Long         '売上データ最終行番号用変数
    
    Application.ScreenUpdating = False
    
    '初期化処理（クリア）
    With Daily
        .Range(.Cells(2, 2), .Cells(33, 4)).ClearContents
    End With
    
    With Fruits
        .Range(.Cells(3, 3), .Cells(20, 14)) = ""
    End With
    
    '商品リスト範囲セット
    With Fruits
        Set rngFrut = .Range(.Cells(3, 1), .Cells(17, 1))
    End With
    
    With Data
        lngERow = .Range("A" & .Rows.Count).End(xlUp).Row                                   '売上データ最終行番号
        
        For r = 3 To lngERow                                                                'すべての売上レコード繰り返し処理
            curSale = 0                                                                     '伝票別売上額リセット
            
            datDate = .Cells(r, 2)                                                          '処理中レコードの伝票日付
            strName = .Cells(r, 3)                                                          '処理中レコードの担当者名
            curVgen = .Cells(r, 14)                                                         '処理中レコードの値引額
            
            '伝票ごとの売上額を加算集計
            For c = 4 To 12 Step 2                                                          '商品①～⑤までを繰り返し処理
                If .Cells(r, c) <> "" Then                                                  '商品欄が空欄じゃない場合
                    strFrut = .Cells(r, c)                                                  '処理中列の商品名
                    intQty = .Cells(r, c + 1)                                               '処理中列の販売数量
                    
                    curSale = curSale + 果物売上(strFrut, intQty)                           '商品別売上額を加算集計
                    
                    Call 商品別店員別売上表へ計上(strName, strFrut, intQty, curVgen, c)
                End If
            Next
            
            Call 日付別売上表へ計上(datDate, curSale, curVgen)
        Next
    End With

    '合計欄処理
    With Fruits
        Call 商品別店員別売上表合計処理
        Call 日付別売上表合計処理
    End With
End Sub

'■果物別店員別売上へ転記する
'[引数：担当者名、商品名、販売数量、値引額、処理中レコードの処理中列番号]
Private Sub 商品別店員別売上表へ計上(ByVal vName As String, ByVal vFrut As String, ByVal vQty As Integer, ByVal vVgen As Currency, ByVal vCol As Integer)
    Dim rngTrgt As Range        '処理中レコードの商品名
    Dim intWRow As Integer      '書込み行用変数
    Dim intWCol As Integer      '書込み列用変数
    
    With Data
        Set rngTrgt = rngFrut.Find(vFrut, lookat:=xlWhole)
    End With
    
    '表への書込み行判定
    If rngTrgt Is Nothing Then
        MsgBox "商品リストに商品が見つかりません"
        Exit Sub
    Else
        intWRow = rngTrgt.Row
    End If
    
    '表への書込み列判定
    Select Case vName
        Case "木村": intWCol = 3
        Case "鈴木": intWCol = 5
        Case "佐藤": intWCol = 7
        Case "田中": intWCol = 9
        Case "高橋": intWCol = 11
    End Select
    
    With Fruits
        .Cells(intWRow, intWCol) = .Cells(intWRow, intWCol) + vQty                                '担当者別販売数量集計
        .Cells(intWRow, intWCol + 1) = .Cells(intWRow, intWCol + 1) + .Cells(intWRow, 2) * vQty   '担当者別売上額集計
        
        If vCol = 4 Then
            .Cells(20, intWCol) = .Cells(20, intWCol) + vVgen                                     '担当者別値引額集計
        End If
    End With
End Sub

'■果物の種類と個数から売上金額を返す関数
'[引数：商品名、販売個数]
'[戻り値：売上金額]
Private Function 果物売上(ByVal strFrut As String, ByVal intQty As Integer) As Currency
    '売上計算
    If rngFrut.Find(strFrut, lookat:=xlWhole) Is Nothing Then                       'リストにない場合
        果物売上 = 0                                                                '0を返す
    Else                                                                            'リストにあった場合
        果物売上 = rngFrut.Find(strFrut, lookat:=xlWhole).Offset(, 1) * intQty      '個数を乗じて売上額を返す
    End If
End Function

'■日付別売上表へ転記する処理
'[引数：日付、1レコード分の売上額、値引額]
Private Sub 日付別売上表へ計上(ByVal vDate As Date, ByVal vSale As Currency, ByVal vVgen As Currency)
    Dim rngTrgt As Range                                            '転記行の日付
    Dim rngDate As Range                                            '日付データ範囲
    
    With Daily
        Set rngDate = .Range(.Cells(2, 1), .Cells(32, 1))           '日付データ範囲セット
        Set rngTrgt = rngDate.Find(vDate, lookat:=xlWhole)          '日付データ範囲から転記先行判定
    End With
    
    If rngTrgt Is Nothing Then
        MsgBox "転記先の日付がありません"
    Else
        With rngTrgt
            .Offset(, 1) = .Offset(, 1) + vSale                     '日付別売上額加算集計
            .Offset(, 2) = .Offset(, 2) + vVgen                     '日付別割引額加算集計
            .Offset(, 3) = .Offset(, 3) + (vSale - vVgen)           '日付別正味売上額加算集計
        End With
    End If
End Sub

'■商品別店員別売上表合計処理の合計処理
Private Sub 商品別店員別売上表合計処理()
    With Fruits
        '販売数量、売上
        For r = 3 To 17                                             '商品別繰り返し処理
            For c = 3 To 11 Step 2                                  '担当者別繰り返し処理
                .Cells(r, 13) = .Cells(r, 13) + .Cells(r, c)        '販売数量集計
                .Cells(r, 14) = .Cells(r, 14) + .Cells(r, c + 1)    '売上集計
            Next
        Next
        
        '全商品
        For c = 3 To 14
            .Cells(18, c) = WorksheetFunction.Sum(.Range(.Cells(3, c), .Cells(17, c)))
        Next
        
        '値引額
        .Cells(20, 13) = WorksheetFunction.Sum(.Range(.Cells(20, 3), .Cells(20, 11)))
    End With
End Sub

'■日付別売上表合計処理
Private Sub 日付別売上表合計処理()
    With Daily
        For c = 2 To 4
            .Cells(33, c) = WorksheetFunction.Sum(.Range(.Cells(2, c), .Cells(32, c)))
        Next
    End With
End Sub

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

Option Explicit

Dim rngFrut As Range '商品一覧

Dim r As Long

Dim c As Long

'■本サンプルコードのメインプログラム

Sub 売上集計()

Dim curSale As Currency '1伝票ごとの売上

Dim datDate As Date '処理中レコードの伝票日付

Dim strName As String '処理中レコードの担当者名

Dim curVgen As Currency '処理中レコードの値引額

Dim strFrut As String '処理中レコードの商品名

Dim intQty As Integer '処理中レコードの販売数量

Dim lngERow As Long '売上データ最終行番号用変数

Application.ScreenUpdating = False

'初期化処理（クリア）

With Daily

.Range(.Cells(2, 2), .Cells(33, 4)).ClearContents

End With

With Fruits

.Range(.Cells(3, 3), .Cells(20, 14)) = ""

End With

'商品リスト範囲セット

With Fruits

Set rngFrut = .Range(.Cells(3, 1), .Cells(17, 1))

End With

With Data

lngERow = .Range("A" & .Rows.Count).End(xlUp).Row '売上データ最終行番号

For r = 3 To lngERow 'すべての売上レコード繰り返し処理

curSale = 0 '伝票別売上額リセット

datDate = .Cells(r, 2) '処理中レコードの伝票日付

strName = .Cells(r, 3) '処理中レコードの担当者名

curVgen = .Cells(r, 14) '処理中レコードの値引額

'伝票ごとの売上額を加算集計

For c = 4 To 12 Step 2 '商品①～⑤までを繰り返し処理

If .Cells(r, c) <> "" Then '商品欄が空欄じゃない場合

strFrut = .Cells(r, c) '処理中列の商品名

intQty = .Cells(r, c + 1) '処理中列の販売数量

curSale = curSale + 果物売上(strFrut, intQty) '商品別売上額を加算集計

Call 商品別店員別売上表へ計上(strName, strFrut, intQty, curVgen, c)

End If

Call 日付別売上表へ計上(datDate, curSale, curVgen)

End With

'合計欄処理

With Fruits

Call 商品別店員別売上表合計処理

Call 日付別売上表合計処理

End With

End Sub

'■果物別店員別売上へ転記する

'[引数：担当者名、商品名、販売数量、値引額、処理中レコードの処理中列番号]

Private Sub 商品別店員別売上表へ計上(ByVal vName As String, ByVal vFrut As String, ByVal vQty As Integer, ByVal vVgen As Currency, ByVal vCol As Integer)

Dim rngTrgt As Range '処理中レコードの商品名

Dim intWRow As Integer '書込み行用変数

Dim intWCol As Integer '書込み列用変数

With Data

Set rngTrgt = rngFrut.Find(vFrut, lookat:=xlWhole)

End With

'表への書込み行判定

If rngTrgt Is Nothing Then

MsgBox "商品リストに商品が見つかりません"

Exit Sub

Else

intWRow = rngTrgt.Row

End If

'表への書込み列判定

Select Case vName

Case "木村": intWCol = 3

Case "鈴木": intWCol = 5

Case "佐藤": intWCol = 7

Case "田中": intWCol = 9

Case "高橋": intWCol = 11

End Select

With Fruits

.Cells(intWRow, intWCol) = .Cells(intWRow, intWCol) + vQty '担当者別販売数量集計

.Cells(intWRow, intWCol + 1) = .Cells(intWRow, intWCol + 1) + .Cells(intWRow, 2) * vQty '担当者別売上額集計

If vCol = 4 Then

.Cells(20, intWCol) = .Cells(20, intWCol) + vVgen '担当者別値引額集計

End If

End With

End Sub

'■果物の種類と個数から売上金額を返す関数

'[引数：商品名、販売個数]

'[戻り値：売上金額]

Private Function 果物売上(ByVal strFrut As String, ByVal intQty As Integer) As Currency

'売上計算

If rngFrut.Find(strFrut, lookat:=xlWhole) Is Nothing Then 'リストにない場合

果物売上 = 0 '0を返す

Else 'リストにあった場合

果物売上 = rngFrut.Find(strFrut, lookat:=xlWhole).Offset(, 1) * intQty '個数を乗じて売上額を返す

End If

End Function

'■日付別売上表へ転記する処理

'[引数：日付、1レコード分の売上額、値引額]

Private Sub 日付別売上表へ計上(ByVal vDate As Date, ByVal vSale As Currency, ByVal vVgen As Currency)

Dim rngTrgt As Range '転記行の日付

Dim rngDate As Range '日付データ範囲

With Daily

Set rngDate = .Range(.Cells(2, 1), .Cells(32, 1)) '日付データ範囲セット

Set rngTrgt = rngDate.Find(vDate, lookat:=xlWhole) '日付データ範囲から転記先行判定

End With

If rngTrgt Is Nothing Then

MsgBox "転記先の日付がありません"

Else

With rngTrgt

.Offset(, 1) = .Offset(, 1) + vSale '日付別売上額加算集計

.Offset(, 2) = .Offset(, 2) + vVgen '日付別割引額加算集計

.Offset(, 3) = .Offset(, 3) + (vSale - vVgen) '日付別正味売上額加算集計

End With

End If

End Sub

'■商品別店員別売上表合計処理の合計処理

Private Sub 商品別店員別売上表合計処理()

With Fruits

'販売数量、売上

For r = 3 To 17 '商品別繰り返し処理

For c = 3 To 11 Step 2 '担当者別繰り返し処理

.Cells(r, 13) = .Cells(r, 13) + .Cells(r, c) '販売数量集計

.Cells(r, 14) = .Cells(r, 14) + .Cells(r, c + 1) '売上集計

'全商品

For c = 3 To 14

.Cells(18, c) = WorksheetFunction.Sum(.Range(.Cells(3, c), .Cells(17, c)))

'値引額

.Cells(20, 13) = WorksheetFunction.Sum(.Range(.Cells(20, 3), .Cells(20, 11)))

End With

End Sub

'■日付別売上表合計処理

Private Sub 日付別売上表合計処理()

With Daily

For c = 2 To 4

.Cells(33, c) = WorksheetFunction.Sum(.Range(.Cells(2, c), .Cells(32, c)))

End With

End Sub

VBAサンプルコードの構成は、メインプログラムを含む5つのサブプロシージャと1つのファンクションプロシージャです。

VBAサンプルコードの実行結果

VBAサンプルコードを、サンプルファイルの標準モジュールに転記することで、実際にExcelシート上でVBAサンプルコードを実行して結果を確かめることができます。

ここでは、VBAサンプルコードの実行結果について解説します。

「商品別店員別売上詳細」シートの集計結果

5人の店員ごとに各商品別で販売数量と売上の集計結果を表示できるクロス集計表の集計結果です。

例えば、佐藤さんはお店の中で一番高いスイカを、このひと月の間に81個も売っていることが分かります。その売上高は243,000円で、スイカの単価3,000円×81と一致していますよね。

別の見方として、例えばこのひと月の間に一番値引を行ったのは、鈴木さんの1,710円だったことがExcelシートの20行目で確認できます。

合計欄については、各担当ごとのひと月の総販売個数と総売上額がExcelシートの18行目で確認できます。また、商品ごとの総販売個数と総売上額は、Excelシート13, 14列目で確認できます。

今回の売上データは、乱数で作成しましたので各商品、各店員ごとにそれほど開きが無く面白みのないデータですが、実際のデータを分析してみるといろいろと問題が洗い出されて、売上改善策を立てるのに役立てそうですよね。

「日付別売上表」シートの集計結果

日付ごとの値引考慮なしの商品売上額（Excelシート2列目）、値引額（Excelシート3列目）、値引額を差し引いた売上合計（Excelシート4列目）を確認できるクロス集計表のVBAコード実行結果です。

最終行では、前述の3項目の総合計を算出表示しています。

2つのクロス集計表の集計結果を比較

以上、確認してきました2つのクロス集計表は、元集計データが同じですので集計結果の切り口は違いますが、合計は当然合わなくてはいけません。そこで、これら2つのクロス集計表のVBA実行結果を比較確認してみました（下図）。

まず、図の赤枠で囲った合計値ですが、それぞれ割引総額を除いた売上額です。また青枠はそれぞれ値引総額であり、緑枠はそれぞれ割引額を引いた売上総額になります。

3つの項目の値を比較してみますとすべて一致しているのが確認できますよね。

VBAサンプルコードのアルゴリズム解説

これよりVBAサンプルコードのアルゴリズムについて解説していきます。

シートオブジェクトのCodeNameプロパティ

今回のVBAサンプルコードでは、ワークシートオブジェクトをCodeNameプロパティで扱います。

図の上から順に、「日付別売上表」シートのCodeNameプロパティを「Daily」、「売上データ」シートのCodeNameプロパティを「Data」、および「商品別店員別売上詳細」シートのCodeNameプロパティをFruitsとしました。

Tips
複数シートをオブジェクト名（CodeNameプロパティ）で扱う方法

モジュール変数宣言部

2行目：Dim rngFrut As Range
「商品別店員別売上詳細」シートにある商品リスト範囲をセットするためのRangeオブジェクト変数です。このrngFrutは、複数のプロシージャで使いますので、モジュール変数として宣言しました。

「売上集計」サブプロシージャ(メインプログラム）

メインプログラム「売上集計」サブプロシージャの解説になりますが、結構長いので適当に区切りながら解説しています。

プロシージャ変数宣言部

8行目：Dim curSale As Currency
集計元レコード1行分（伝票単位）の売上額を保持する変数です。データ型は通貨型を使用しています。

Tips
通貨型を含むVBA集計業務のデータ型

9行目：Dim datDate As Date
集計元レコードの該当する伝票日付を保持する変数です。データ型は日付型を指定しています。

10行目：Dim strName As String
集計元レコードは、1レコードごとに日付・担当者が分かれています。変数「strName」は、その処理中レコードの店員の名前を保持する変数です。

11行目：Dim curVgen As Currency
集計元レコードの処理中レコードの値引額を保持する変数です。金額を取り扱うのでデータ型を通貨型(Currency）にしています。

13行目：Dim strFrut As String
処理中の商品名を保持する変数です。

14行目：Dim intQty As Integer
処理中の販売個数を保持する変数です。

集計先データ範囲初期化（クリア）処理

VBAコード21～27行目は、下図の通り2つのクロス集計表の集計先範囲を初期化（クリア）しています。VBAコード21～23行目で、日付別売上表の集計先データ範囲を、VBAコード25～27行目で商品別店員別売上詳細シートのデータ範囲をクリアしています。

そしてクリア処理した後の、状態が下図です。

また商品別店員別売上詳細シートのCells(21, 14)には、下図で示すように数式が入力されていますので、VBAコードでクリア処理する際の対象外にしています。

ちなみにこの数式が入力されているセルも、VBAコードでクリア処理して数式を入力することも可能ですが、今回はそうせずに常に数式が入力された状態としています。

商品リスト範囲セット

31行目：Set rngFrut = .Range(.Cells(3, 1), .Cells(17, 1))
商品別店員別売上詳細シートのCells(3, 1)からCells(17, 1)までを、商品リストとしてRangeオブジェクト変数「rngFrut」にセットしています。

Tips
VBAコードのWithの使い方

集計元データの読み取りと集計先クロス集計表への転記処理

これより実際に「売上データ」シート上に入力されている売上レコードを1つ1つ繰り返し処理し、集計先となる2つのクロス集計表へ転記するVBAコードを解説していきます。

35行目：lngERow = .Range("A" & .Rows.Count).End(xlUp).Row
「売上データ」シートの最終レコードが入力されているExcel行番号を求めています。

Tips
VBAで最終レコードの行番号を求める方法

集計元データ繰り返し処理部

VBAコード37～57行目では、For ～ Next文で「売上データ」シートにある集計元レコードの1つ1つを繰り返し処理しています。

38行目：curSale = 0
通貨型変数「curSale」は、集計元レコード1行ごと（1会計伝票ごと）の売上合計を保持する変数です。そのため各行処理前に、毎回保持している値をこのVBAコードでリセットしています。

VBAコード40～42行目は、処理中レコード行(r行)の「日付」（赤）、「販売担当者」（青）、「値引き」（緑）の値を、それぞれの変数に代入している処理です。

1伝票中の売り上げた複数の商品に対する処理

VBAコード45～54行目は、「売上データ」の商品①～商品⑤までのそれぞれの「品名」と「個数」（販売数量）に対する処理を、For ～ Next文で繰り返し処理しています。

VBAコード45～54行目のFor ～ Next文による商品①～商品⑤までの「品名」と「個数」に対する処理

46行目：If .Cells(r, c) <> "" Then
ここで「品名」が入力されているセルを調べ、品名が入力されていれば、VBAコード47行目以降を実行するようにしています。

Tips
VBAコードのIf文の使い方

47行目：strFrut = .Cells(r, c)
48行目：intQty = .Cells(r, c + 1)
商品①～商品⑤の各「品名」と「個数」（販売個数）を、それぞれ保持する変数に代入しています。

50行目：curSale = curSale + 果物売上(strFrut, intQty)
対象レコードの売上額を集計するVBAコードです。ここで記載されている「果物売上」は、あとで詳述する「果物売上」ファンクションプロシージャです。このファンクションプロシージャは、引数として商品名と販売個数を渡せば、売上金額が戻ってくる関数です。

VBAコード47、48行目で品名（青字）と個数（緑字）を保持した変数「strFrut」と「intQty」を、「果物売上」ファンクションプロシージャに渡し、戻り値として得た売上額を加算集計しています。

52行目：Call 商品別店員別売上表へ計上(strName, strFrut, intQty, curVgen, c)
こちらもあとで詳述しますが、サブプロシージャ「商品別店員別売上表へ計上」を呼び出し、商品別店員別売上詳細シートへ商品①～商品⑤の情報を計算して転記しています。

先に処理のイメージを図にしてみましたのでご参考ください。

「商品別店員別売上表へ計上」サブプロシージャの処理イメージ（伝票番号0001終了時）

処理内容は、売上データシート上の商品①～商品⑤の各「品名」、「個数」の情報をもとに、商品別店員別売上詳細シート上の該当する担当者と商品リストの行に、販売数量と計算した売上金額を転記します。

56行目：Call 日付別売上表へ計上(datDate, curSale, curVgen)
集計元データの各レコード繰り返し処理の最後の処理になります。こちらもあとで詳述する「日付別売上表へ計上」サブプロシージャを呼び出し処理しています。

処理概要は、下図のように引数として日付、1レコード分の売上合計、値引額を渡すと、該当する日付の行に売上と割引を転記し、内部で売上合計（値引額除く）を計算します。

62行目：Call 商品別店員別売上表合計処理
63行目：Call 日付別売上表合計処理
2つのクロス集計表の合計処理になります。詳述はのちほど記載しておりますが、VBAコード62行目前までの処理状況は下図の通り合計欄はまだ空欄です。

上図の状況のあと、VBAコード62, 63行目が実行されることにより、合計欄が集計されます。

「商品別店員別売上表へ計上」サブプロシージャ

売上データシート上の各レコードのデータを読み取った値を受取り、商品別店員別売上詳細シートへ集計させるサブプロシージャです。

69行目：Private Sub 商品別店員別売上表へ計上(ByVal vName As String, ByVal vFrut As String, ByVal vQty As Integer, ByVal vVgen As Currency, ByVal vCol As Integer)
サブプロシージャの宣言部になります。引数は、以下の通り5つあります。

「店員名」
「商品名」
「販売個数」
「値引額」、
処理対象レコードの商品①～商品⑤に対する処理中の列番号

70行目：Dim rngTrgt As Range
75行目：Set rngTrgt = rngFrut.Find(vFrut, lookat:=xlWhole)
商品リストの中の商品と、引数で受け取った「商品名」が一致した時に、そのセルをRangeオブジェクトとして保持するオブジェクト変数をVBAコード70行目で宣言しています。

実際の変数セットは、VBAコード75行目で実行しており、商品リスト範囲（rngRfut)からFindメソッドで引数「vFrut」と一致するセルをrngTrgtにセットしています。

VBAコード79～84行目は、75行目でrngTrgtオブジェクト変数にセットされた中身をチェックして、その結果で処理を分けています。

上図赤の部分は、商品リストの中に引数で受け取った商品名が無かった場合の条件文です。rngTrgt Is Nothingは、rngTrgtオブジェクト変数の中身が無い、すなわちVBAコード75行目の処理結果が何も得られなかったことを表しています。

VBAコード79行目の条件に合致しない場合、すなわちVBAコード75行目の処理の結果、rngTrgtに値がセットされた場合は、VBAコード83行目（下図青字）が実行されます。

VBA83行目でデータ書込み行intWRowが決まる — VBA83行目でデータ書込み行intWRow（=青枠数字）が決まる

VBAコード87～93行目は、商品別店員別売上表のデータ書込列を判定しています。引数vNameは担当者名であり、そのvNameをSelect文の条件判定に用いることにより、担当者ごとにデータが振り分けられる仕組みです。

Tips
VBAコードのSelect分岐構文の基本的な使い方

96行目： .Cells(intWRow, intWCol) = .Cells(intWRow, intWCol) + vQty
書込み行（intWRow)と書込み列(intWCol）が決まりましたので、ここでは該当する担当者別に、販売数量を集計する処理をしています。イメージとしては、以下の図のような感じになります。

97行目：.Cells(intWRow, intWCol + 1) = .Cells(intWRow, intWCol + 1) + .Cells(intWRow, 2) * vQty
各担当者ごとの商品別売上高を加算集計するVBAコードです。下図の青文字は、各商品の売価が入力されている範囲で、Excelシートの2列目にあります。これとVBAコード96行目でも利用した販売個数「vQty」を乗じることで、商品ごとの売価が計算できます。

その売価をこのVBAコードで加算集計しています。

VBAコード99～101行目は、商品別店員別売上表20行目の値引額を集計するコードです。メインプログラムで呼び出される際に、引数として渡された処理対象列を、VBAコード99行目のIf文で判定し、列番号が4行目の時だけ値引額を売上別店員別売上表に加算集計します。

ここで列番号が4の時にだけ割引額を加算集計している理由ですが、売上データを確認すると「割引額」は1レコードにつき１個ですよね。ところが、「商品別店員別売上表へ計上」プロシージャは、1レコードにつき商品①～商品⑤までの最大5回まで実行される可能性があります。

そうなると、VBAコード99行目のIf文が無ければVBAコード100行目によって、割引額の加算が最大5回まで加算集計されてしまいます。まさに重複計上を起こしてしまうのです。

そこで、考え方の1つとして、「1つのレコードには必ず商品①（処理列番号4）はあるはずだから、列番号4の処理の時だけ同時に値引額の集計もしてしまおう」と考えたわけです。

「果物売上」ファンクションプロシージャ

果物の種類と販売個数を引数として受け取り、売り上げを返すファンクションプロシージャの解説です。

108行目：Private Function 果物売上(ByVal strFrut As String, ByVal intQty As Integer) As Currency
引数strFrutは「商品名」、intQtyは「販売個数」です。戻り値のデータ型は、通貨型(Currency)としました。

VBAコード110行目は、既に解説しましたVBAコード79行目と同じ考え方になります。ここで引数の商品名が商品リストの中にない場合、If文の条件式がTrueとなり、つづくVBA111行目の処理が行われ、戻り値0を返します。

一方、引数で渡された商品名が商品リストの中にある場合、VBAコード113行目が実行され、戻り値として売上額（商品の値段×個数）が返されます。

「日付別売上表へ計上」サブプロシージャ

119行目：Private Sub 日付別売上表へ計上(ByVal vDate As Date, ByVal vSale As Currency, ByVal vVgen As Currency)
サブプロシージャの宣言部です。引数は、日付、1レコード分の売上合計、値引額です。

121行目：Dim rngTrgt As Range
124行目：Set rngDate = .Range(.Cells(2, 1), .Cells(32, 1))
VBAコード121行目は、日付別売上表シートの日付範囲をセットするためのオブジェクト変数です。VBA124行目でそのオブジェクト変数に、図の日付入力範囲をセットします。

VBAコード128～136行目は、前でセットした日付範囲の中に、引数で渡された日付が一致するか否かで処理を分けているIf構文になります。VBAコード128行目のIf文の条件式の考え方は、これまで出てきたVBAコード79行目と110行目と同じになります。

VBAコード132～134行目は、引数と一致した日付をセットしたrngTrgtからのOffsetプロパティによって、「売上額」（値引額控除前）（赤）、「値引額」（青）、「売上額」（値引額控除後）（緑）を加算集計しています。

引数で渡された日付に一致するセルからのOffsetプロパティで集計先のセルを指定する

Tips
RangeオブジェクトのOffsetプロパティの基本的な使い方

「商品別店員別売上表合計処理」サブプロシージャ

商品別店員別売上表の合計欄の集計処理を行うサブプロシージャです。

VBAコード143行目のFor文は、クロス集計表の行方向の繰り返し処理をします。VBAコード144行目のFor文は、クロス集計表の列方向の繰り返し処理をしますが、Step 2が記載されていますので1列置きに処理されます。

VBAコード145と146行目は、それぞれ商品別の販売数量と売上を加算集計しています。

VBAコード151～153行目は、列方向の繰り返し処理を用いてクロス集計表18行目の合計欄を集計しています。またVBAコード156行目は、青枠で囲った値引額総額を表示するセルを集計します。

見づらいですが、図の青網掛けで囲った範囲を指定したワークシート関数Sumを使い集計結果を算出しています。

「日付別売上表合計処理」サブプロシージャ

「日付別売上表」シートにあるクロス集計表の合計欄に、合計値を集計して表示します。

VBAコード163～165は、列方向の繰り返し処理を使い、クロス集計表33行目の3つのセル（下図赤枠）の合計値を集計します。

まとめ

集計元の売上データを2つのクロス集計表に集計させるVBAサンプルコードについてご紹介しました。1つ目のクロス集計表は、集計元の売上データから、店員別に商品ごとの販売個数と売上額を集計し、さらに各店員ごとの総割引額（1か月にいくら値引したのか）も集計したものでした。

この1つ目のクロス集計表により、例えばどの店員がどの商品を1番売上たか、どの商品が一番売り上げが悪かったのかなどの分析に使えそうです。また、あらかじめ店員ごとの割引額を設定しておいて、月末締めの集計時に割引総額がきちんと制限内に抑えられているかなどの管理にも使えそうです。

もう1つのクロス集計表は、日ごとの売上総額と割引額を集計したものでした。このクロス集計表を元に、横軸に日付、縦軸に金額（売上額と値引額の内訳）を設定した棒グラフなどで表示すると、日別や月別の売上推移グラフが簡単に作れそうです。

[スポンサーリンク]

サイト内検索

-別シート, 転記する
-クロス集計表

: VBAで月次予算実績推移の棒グラフを部門別内訳にして作成する
VBAで集計対象データをグラフ用集計表へ集計させ、月次予算実績報告グラフを作成します。月次予算実績報告グラフは、棒グラフで月ごとの予算と実績を比較でき、さらに予実の棒グラフはそれぞれ部門ごとに内訳表示 ...

: VBAで複数シートを参照テーブル経由で1つのシートにまとめる
VBAで複数シート上のレコードを、参照テーブルを介して1つのシートに集計します。今回は集計対象となる複数シートの項目を、集計先のシートの項目に合わせるために、転記の途中で参照テーブルを見にいかせます。 ...

: VBAコードで対象レコードとは別シートに集計させる
集計対象レコードのあるシートとは別シートに、クロス集計表を作ります。対象レコードのフィールド（見出し項目）数が多い場合、同一シート上に表を作成するスペースがありませんよね。そういう時は、対象レコードと ...

: VBAコードで部門別費目別に月ごとの経費をクロス集計する
部門毎に各費目内訳がある2段行見出しのクロス集計表です。会計データから月別の経費実績を集計します。また作成される結果の表は別シートになります。部門別に各月の経費実績表を作ると、さらに各部門を費目別に ...

: VBAで生データの複数項目列の削除と並べ替えの一括処理を行う
生データから集計に関係のない複数列を削除すると同時に、列順を任意の順番に並べ替えて別シートに表示するサンプルコードをご紹介します。 Excel集計業務では、基幹システムから得られた生データを集計前に加 ...

: VBAで年間予算実績トラッキンググラフと四半期レポートを作成
年間の予算消費状況を月次でトラッキングできるExcelグラフと、プレゼン用として四半期ごとにまとめた各部門の予実差異レポートを同時に作成するVBAサンプルコードを詳しくご紹介します。今回は集計対象デ ...

: VBAコードで部門別に各経費費目に分けて集計する
会計データから部門別の経費消費状況を、会計データとは別シート上にクロス集計するサンプルコードです。会社の基幹システムの会計データを使い、各部門が経費をどのくらい消費しているかを表にまとめてチェックす ...

: VBAコードで部門別費目別予実別に月ごとの経費を集計する
部門別に各費目内訳があり、さらに各費目ごとに予算実績内訳がある3段行見出しのクロス集計です。会計データから月別の経費実績を、別シートに集計させます。実務ではSAPなどのシステムから抽出する会計データ ...

: VBAコードで部門別に月ごとの経費を集計するサンプル
会計データから、部門別に月ごとの経費消費実績をクロス集計させます。作成するクロス集計表は、会計データとは別シートに作成されます。基幹システムから得た会計データに対して、会計月ごとに部門別の実績を表に ...

: VBAで予算内訳を部門、実績内訳を費目にしたグラフを自動作成
会社の経費データから毎月の予算・実績を比較した棒グラフをVBAで自動作成するサンプルコードです。予算と実績の棒グラフ内訳は、予算は部門別に、実績は費目別にしています。例えば、予算内訳は年間を通じて各 ...

PREV: VBAで集計対象データをカテゴリ別複数シートに分けて集計する
NEXT: VBAで複数サブフォルダ内に存在する閉じた複数ファイルを集計