Excel VBAで任意の種類同士を足し合わせたものを集計したいです

前提・実現したいこと

完全なVBA初心者です。
自分で調べてできる範囲でチャレンジしてみましたが行き詰まり、ここで質問させていただきます。

Sheet1内のデータを、タイトル毎の集計だけではなく
購入国をJPかそれ以外かで分け、更に購入額+消費税額で集計したものと、購入額のみで集計したものを分けて算出したいです。

変数シートに記載したものをVBAで参照してその通りに足し合わせようとしましたがうまくいかず、
コードもめちゃくちゃなことになってしまいました。

どのようにすれば意図したデータの抽出ができるか教えていただきたいです。

データサンプル

【Sheet1】

【変数】

【理想の集計後データ】

コード

Option Explicit


Public Sub 集計()
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim sh3 As Worksheet
    Dim dictTransaction As Object      '取引区分
    Dim dictTitle As Object      'タイトル
    Dim dictAmount As Object      '金額
    Dim s1 As String              'JP変数
    Dim s2 As String              'JP以外変数
    Dim s3 As String              '入金額変数
    Dim s4 As String              '売上金額変数
    Dim key As Variant
    Dim maxrow1 As Long
    Dim row1 As Long
    Dim row2 As Long
    Dim keys As Variant
    Dim colTest As New Collection
    Set dictAmount = CreateObject("Scripting.Dictionary") ' 連想配列の定義
    Set sh1 = Worksheets("Sheet1")
    Set sh2 = Worksheets("Sheet2")
    Set sh3 = Worksheets("変数")
    maxrow1 = sh1.Cells(Rows.Count, "A").End(xlUp).Row '元データ 最終行を求める
    
    s1 = sh3.Range("D2").Address
    s2 = sh3.Cells("D3").Select
    s3 = sh3.Range("A2:A5").Address
    s4 = sh3.Range("B2:B3").Address
    
    For row1 = 2 To maxrow1
        'タイトル＋取引区分＋購入国をキーとする
        key = sh1.Cells(row1, "G").Value & "|" & s3 & "|" & s1
        '最初のキーの場合、値を０で初期化する
        If dictAmount.Exists(key) = False Then
            dictAmount(key) = 0
            'dictBara(key) = 0
        End If
        dictAmount(key) = dictAmount(key) + sh1.Cells(row1, "D").Value   '金額を加算
    Next
    '集計結果へ出力する
    '2行目以降をクリアする
    sh2.Rows("2:" & Rows.Count).ClearContents                     'Sheet2の2行目以降をクリア
    row2 = 2
    For Each key In dictAmount
        keys = Split(key, "|")  'キーを日付と商品コードにばらす
        sh2.Cells(row2, "A").Value = keys(0)            'タイトル
        sh2.Cells(row2, "B").Value = keys(1)            '取引区別
        sh2.Cells(row2, "C").Value = dictAmount(key)    '金額
        sh2.Cells(row2, "D").Value = keys(2)            '購入国
        row2 = row2 + 1
    Next
    MsgBox ("完了")
End Sub

tatsu99

2021/06/17 02:10

商品Dの理想の集計後データは入金額　＝１１００売上金額＝１０００となっています。ということは、返金額と消費税返金額は集計対象外ということでしょうか。もし、集計対象外なら、何故、変数シートに返金額と消費税返金額が記載されているのでしょうか。

行動規範の内容に同意します

回答1件

ベストアンサー

こんな感じでどうでしょうか。

vba
1    Dim sh3 As Worksheet
2    Set sh3 = Worksheets("変数")
3    
4    Dim dictT As Scripting.Dictionary
5    Set dictT = CreateObject("Scripting.Dictionary")
6    
7    Dim i, j
8    For j = 1 To 2
9        For i = 2 To sh3.Cells(Rows.Count, j).End(xlUp).Row
10            dictT(sh3.Cells(i, j)) = sh3.Cells(1, j)
11        Next
12    Next
13    
14    Dim kuni
15    kuni = sh3.Range("C2").Value
16    
17    Dim sh1 As Worksheet
18    Set sh1 = Worksheets("Sheet1")
19    
20    Dim maxrow1 As Long
21    maxrow1 = sh1.Cells(Rows.Count, "A").End(xlUp).Row '元データ 最終行を求める
22    
23    Dim row1 As Long
24    Dim key As Variant
25    Dim k(2)
26    Dim dictAmount As Object      '金額
27    Set dictAmount = CreateObject("Scripting.Dictionary") ' 連想配列の定義
28    
29    For row1 = 2 To maxrow1
30        k(0) = sh1.Cells(row1, 2)
31        k(1) = dictT(sh1.Cells(row1, 1))
32        k(2) = IIf(sh1.Cells(row1, 3) = kuni, kuni, kuni & "以外")
33        
34        key = Join(k, "|")
35        dictAmount(key) = dictAmount(key) + sh1.Cells(row1, 4)
36    Next
37    
38    Dim sh2 As Worksheet
39    Set sh2 = Worksheets("Sheet2")
40    sh2.Rows("2:" & Rows.Count).ClearContents                     'Sheet2の2行目以降をクリア
41    
42    Dim row2 As Long
43    row2 = 2
44    Dim keys As Variant
45    
46    For Each key In dictAmount
47        keys = Split(key, "|")
48        sh2.Cells(row2, "A").Value = keys(0)            'タイトル
49        sh2.Cells(row2, "B").Value = keys(1)            '取引区別
50        sh2.Cells(row2, "C").Value = dictAmount(key)    '金額
51        sh2.Cells(row2, "D").Value = keys(2)            '購入国
52        row2 = row2 + 1
53    Next
54    MsgBox ("完了")

＜追記＞
消費税を合算しない場合のことを忘れていました。

VBA
1
2'（略）    
3    Dim dictA As Object      '金額
4    Set dictA = CreateObject("Scripting.Dictionary") ' 連想配列の定義
5    Dim dictZ As Object      '消費税
6    Set dictZ = CreateObject("Scripting.Dictionary") ' 連想配列の定義
7    
8    For row1 = 2 To maxrow1
9        k(0) = sh1.Cells(row1, 2)
10        k(1) = dictT(sh1.Cells(row1, 1))
11        k(2) = IIf(sh1.Cells(row1, 3) = kuni, kuni, kuni & "以外")
12        
13        key = Join(k, "|")
14        
15        If Not sh1.Cells(row1, 2) Like "*税*" Then
16            dictA(key) = dictA(key) + sh1.Cells(row1, 4)
17        Else
18            dictZ(key) = dictZ(key) + sh1.Cells(row1, 4)
19        End If
20    Next
21    
22    Dim sh2 As Worksheet
23    Set sh2 = Worksheets("Sheet2")
24    sh2.Rows("2:" & Rows.Count).ClearContents                     'Sheet2の2行目以降をクリア
25    
26    Dim row2 As Long
27    row2 = 2
28    Dim keys As Variant
29    
30    For Each key In dictAmount
31        keys = Split(key, "|")
32        sh2.Cells(row2, "A").Value = keys(0)                'タイトル
33        sh2.Cells(row2, "B").Value = keys(1)                '取引区別
34        sh2.Cells(row2, "C").Value = dictA(key) + dictZ(key) '金額+消費税
35        sh2.Cells(row2, "D").Value = keys(2)                '購入国
36'       sh2.Cells(row2, "E").Value = dictA(key)             '金額
37        row2 = row2 + 1
38    Next
39    MsgBox ("完了")
40