[[20250715154859]] 『Sumifを使わないVBAでの集計』(Thomas) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) |

| 全文検索 | 過去ログ ]

 

『Sumifを使わないVBAでの集計』(Thomas)

Sumifsを使わずにVBAのコードで集計を行いたく、下記のようなコードを書いたのですが、うまくいきません。 ネットで同じようなコードの参考例があるのですが、全て"Range"で記載されてあり、私の未熟な知識では理解ができずにいます。そこで大変恐れ入りますが、どこをどのように変更すればよいかをご教示頂けますとありがたいです。

    A      B           C       D        E         F          G
1 支店C   扇風機      1,000            支店A    扇風機     1,000
2 支店B   エアコン    2,000            支店A    エアコン     0 
3 支店C   テレビ      3,000            支店A    テレビ       0
4 支店D   洗濯機      4,000            支店A    洗濯機     8,000
5 支店A   洗濯機      4,000            支店B    扇風機       0
6 支店D   テレビ      3,000            支店B    エアコン   4,000
7 支店A   洗濯機      4,000            支店B    テレビ       0
8 支店B   エアコン    2,000            支店B    洗濯機       0
9 支店A   扇風機      1,000            支店C    扇風機     1,000

Aに店名
Bに家電種類
Cに売上
Dは空欄
Eは店名の集計用
Fは家電種類のの集計用
GはCの合計
Cにの各支店の各家電の売上をGに集計したい

Sub test()
Dim a, b, M

M = 0

For b = 1 To Cells(Rows.Count, 5).End(xlUp).Row

    For a = 1 To Cells(Rows.Count, 1).End(xlUp).Row

    If Cells(a, 1) = Cells(b, 5) And Cells(a, 2) = Cells(b, 6) Then
    M = M + Cells(a, 3)
    End If

    Cells(b, 7) = M

    Next
Next

M = M + 1

End Sub

< 使用 Excel:Excel2010、使用 OS:Windows8 >


 こうじゃないですか?

 Sub test()
     Dim a, b, M

     M = 0

     For b = 1 To Cells(Rows.Count, 5).End(xlUp).Row

         For a = 1 To Cells(Rows.Count, 1).End(xlUp).Row
             If Cells(a, 1) = Cells(b, 5) And Cells(a, 2) = Cells(b, 6) Then
                 M = M + Cells(a, 3)
             End If
         Next

         Cells(b, 7) = M '累計を記入
         M = 0           '累計を初期化して次の項目処理へ
     Next
 End Sub

(半平太) 2025/07/15(火) 17:02:45


 極力シンプルに。

 Sub test()

 Dim a, b

 For b = 1 To Cells(Rows.Count, 5).End(xlUp).Row
     For a = 1 To Cells(Rows.Count, 1).End(xlUp).Row
         If Cells(a, 1) = Cells(b, 5) And Cells(a, 2) = Cells(b, 6) Then
             Cells(b, 7) = Cells(b, 7) + Cells(a, 3)
         End If
     Next
 Next

 End Sub

(名無し) 2025/07/15(火) 17:12:46


 ↑G列に既にデータがある場合は、実行するたびに加算されるので注意。

(名無し) 2025/07/15(火) 17:25:28


みな様から頂いたコードを早速試してみたところ、どちらもうまくいきました。ご教示頂きまして有難うございました。但しどうしてうまくいくのかがまだ理解が追いついていないので、もう少し考えてみます。
有難うございました。
(Thomas) 2025/07/15(火) 17:30:41

ちなみに、SUMIFS関数を使用したくない理由はなんですか?
単に勉強のためならいいのですが、この用途だと圧倒的に関数のほうが便利だと思うのですが・・・

 Sub test()
     Range("G1").Resize(Cells(Rows.Count, "A").End(xlUp).Row).Formula = "=SUMIFS($C$1:$C$9,$A$1:$A$9,E1,$B$1:$B$9,F1)"
 End Sub
(あ) 2025/07/15(火) 18:14:33

 2010にはSUMIFS関数がないからでわ?
 ピボットテーブル使うのが簡単だとおもいますが
(´・ω・`) 2025/07/15(火) 18:42:46

私のパソコンでもSUMIFSは使えるのですが、勉強の為にVBAでやってみようと思いネットで調べたのですが、すごく長いコードばかりなのと、色々複雑すぎて私には理解できなかったので、もっと簡単なコードでできないものかと思い、相談させて頂きました。単純にこのコードが知りたのと、さらにこの様な考え方を理解しておけば、他に何かあった場合に応用ができるのでは と知識をため込んでおきたくご相談させて頂きました。皆さま色々と有難うございます。
(Thomas) 2025/07/15(火) 18:58:19

トピ主様、了解しました。
丁寧にありがとうございます。
(あ) 2025/07/15(火) 19:01:36

>2010にはSUMIFS関数がないからでわ?
>(´・ω・`) 2025/07/15(火) 18:42:46

2007から追加されたはずだけど、
いつなくなったの?

(樫の木ムック) 2025/07/15(火) 19:09:28


 そうでしたか
 間違いでした
(´・ω・`) 2025/07/15(火) 19:14:09

 >但しどうしてうまくいくのかがまだ理解が追いついていないので
 「2重ループ」が理解を深めるポイントだと思います。
 「VBA 2重ループ」といった検索ワードでWeb検索し、自分に合った解説を読んでみてください。

 そしてコードに対して「ステップ実行」を行うとコードの動きを理解することができると思います。
 Excelシートの画面とVBE(コードの画面)を並べて表示しながらステップ実行すると、1行ごとの変化が目に見えます。
 こちらも「VBA ステップ実行」といった検索ワードでWeb検索すると多くの解説サイトがヒットします。
 ステップ実行は「デバッグ」の基本的な方法ですので、習得されることをお勧めします。
(コメ) 2025/07/15(火) 19:58:15

アドバイス頂きありがとうございます。
今日仕事の合間に検索してみます。
(Thomas) 2025/07/16(水) 10:13:00

 単純にSumIfsが使用できないということならSumProductで...

 Sub test()
    Dim n&
    n = Cells.SpecialCells(11).Row
    With Range("g1:g" & n)
        .Formula = Replace("=if(counta(e1:f1),sumproduct((a$1:a$#=e1)*(b$1:b$#=f1),c$1:c$#),"""")", "#", n)
        .Value = .Value
    End With
End Sub
(jindon) 2025/07/16(水) 10:41:05

 出力先に 支店D が無いですよね。まぁ10行目、11行目にあるけど記載を省略してるのかもしれませんが。

 下記は、E列支店名とF列家電名をあらかじめ用意(入力)しなくても、A列・B列から該当する支店・家電名で集計してE列〜G列に出力するマクロです。
 Dictionaryオブジェクトというものを使用しています。Dictionaryオブジェクトはこの学校でも検索すればたくさん事例があるので、
 よかったら見てみて下さい。
 私もこの学校をきっかけに学びました。

 Sub dic_test()

    Dim dic As Object
    Dim mykey As String
    Dim i As Long
    Dim lastrow As Long
    Dim keyrow As Long

    Set dic = CreateObject("Scripting.Dictionary")

    With ActiveSheet
        lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
        For i = 1 To lastrow
            mykey = .Cells(i, 1).Value & "_" & .Cells(i, 2)
            If dic.exists(mykey) = False Then
                dic.Add mykey, .Cells(i, 3).Value
                Else
                dic.Item(mykey) = dic.Item(mykey) + .Cells(i, 3)
            End If
        Next i

        .Columns("E:G").ClearContents
        keyrow = dic.Count
        .Range("E1").Resize(keyrow, 1).Value = Application.WorksheetFunction.Transpose(dic.keys)
        .Range("G1").Resize(keyrow, 1).Value = Application.WorksheetFunction.Transpose(dic.Items)

        .Range("E1").Resize(keyrow, 3).Sort Key1:=.Range("E1").Resize(keyrow, 1)
        .Range("E1").Resize(keyrow, 1).TextToColumns Destination:=Range("E1"), Other:=True, OtherChar:="_"

    End With

 End Sub

 久しぶりにDictionaryのコードを書いたのでちょっと不安ではありますが。
 jindonさん、どこか変だったら指摘して下さい m(__)m

(純丸) 2025/07/16(水) 13:41:14


 純丸さん、お久しぶりです。
 E:F列にA:B列のユニーク値を生成してG列に合計を記す
 ということですね?

 ご呈示のコードで完璧です。
 敢えてということで

            If dic.exists(mykey) = False Then
                dic.Add mykey, .Cells(i, 3).Value
                Else
                dic.Item(mykey) = dic.Item(mykey) + .Cells(i, 3)
            End If
 の部分は、下記一行に短縮できるのとExistsメソッドを省略できるので幾分速度が上がると思います。
            dic.Item(mykey) = dic.Item(mykey) + .Cells(i, 3)

 私ならまずデータを配列に格納してから始めます。 
 (Valueプロパティを省略したいので...)

 参考程度で...

 Sub test()
    Dim a, i&, ii&, s$, dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    With [a1].CurrentRegion
        a = .Resize(, 3).Value
        .Columns("e:g").EntireColumn.ClearContents
        For i = 1 To UBound(a, 1)
            s = Join(Array(a(i, 1), a(i, 2)), Chr(2))
            If Not dic.exists(s) Then
                dic(s) = dic.Count + 1
                For ii = 1 To UBound(a, 2)
                    a(dic(s), ii) = a(i, ii)
                Next
            Else
                a(dic(s), 3) = a(dic(s), 3) + a(i, 3)
            End If
        Next
        With .Columns("e").Resize(dic.Count, 3)
            .Value = a
            .Sort .Columns(1), , .Columns(2)
        End With
    End With
End Sub
(jindon) 2025/07/16(水) 16:07:57

 jindonさん、ありがとうございます。
 なるほど Existsメソッド 無くても回りますね。はなからKeyの存在を調べないとエラーになると思い込んでました。
 コードによっては必要無いこと、勉強になりました。

 それと提示いただいたマクロですが、先にデータを配列にするとはさすがですね。
 ちょっとわからない部分もありますが、これから勉強します。

 ひとつだけ  .Columns("e:g").EntireColumn.ClearContents の EntireColumn は必要ですか?
 無くても同じように思えますが?
 
(純丸) 2025/07/16(水) 18:42:53

 念のためといいますか、E:G列がA:C列より多くの行があらかじめ入力されていた場合等を想定しました。
(jindon) 2025/07/16(水) 18:52:16

 念の為なんですね。
 勝手にお名前を挙げてチェックをお願いしたりして申し訳ありませんでした。
 今後もよろしくお願いします。
 
(純丸) 2025/07/17(木) 09:47:58

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.