• ベストアンサー
※ ChatGPTを利用し、要約された質問です(原文:SUMIF関数と同じ集計をVBAで行いたい)

VBAでSUMIF関数と同じ集計を行いたい!

このQ&Aのポイント
  • データ数が膨大なため、SUMIF関数では処理が遅くなってしまいます。そこでVBAを使用して同じ集計を行いたいです。
  • 12枚のシートに同じレイアウトのデータがあります。各シートごとに行数が異なります。
  • 集計結果Sheetには、品名ごとの収入計と支出計を集計する必要があります。

質問者が選んだベストアンサー

  • ベストアンサー
  • n-jun
  • ベストアンサー率33% (959/2873)
回答No.2

>なお、一番後ろのシート名は何でも良いのでしょうか? なんでも(白紙)でいいです。 >申し訳ございませんが、下記の部分で実行エラー13 型が一致しません >とエラーが出ます。 >: x(2, k) = x(2, k) + v(i, 2) シートの左から1~12番目で間違いないですか? 収入・支出はC・D列の2行目からで、数字(文字列)ではないですよね? 空白セルとかが途中にありますか?

yuripp
質問者

お礼

すみません、出来ました! 丁寧なご回答、ありがとうございました。

その他の回答 (1)

  • n-jun
  • ベストアンサー率33% (959/2873)
回答No.1

Sub test()  Dim Dic As Object  Dim ws As Integer  Dim v As Variant  Dim x As Variant  Dim i As Long, j As Long, k As Long  Set Dic = CreateObject("Scripting.Dictionary")  ReDim x(1 To 3, 1 To 1)    For ws = 1 To 12      With Worksheets(ws)           v = .Range(.[B2], .Cells(Rows.Count, 2).End(xlUp).Resize(, 3))      End With      For i = 1 To UBound(v, 1)          If Not Dic.exists(v(i, 1)) Then             j = j + 1             Dic(v(i, 1)) = j             x(1, j) = v(i, 1): x(2, j) = v(i, 2): x(3, j) = v(i, 3)             ReDim Preserve x(1 To 3, 1 To j + 1)          Else             k = Dic(v(i, 1))             x(1, k) = v(i, 1): x(2, k) = x(2, k) + v(i, 2): x(3, k) = x(3, k) + v(i, 3)          End If      Next  Erase v  Next  With Worksheets(Worksheets.Count)      .Cells.ClearContents      .Range("A1:C1").Value = Array("品名", "収入", "支出")      .Range("A2").Resize(j, 3).Value = Application.Transpose(x)  End With  Erase x  Set Dic = Nothing End Sub シート1~シート12の結果が一番後ろに新規でシートを作っておけば そこに表示されるはずです。 試してみて下さい。

yuripp
質問者

補足

ご教授の程、ありがとうございました。 申し訳ございませんが、下記の部分で実行エラー13 型が一致しませんとエラーが出ます。 : x(2, k) = x(2, k) + v(i, 2) なお、一番後ろのシート名は何でも良いのでしょうか?

関連するQ&A