エクセルVBA SUMIFSの高速化

エクセルVBA初心者です。ご教授いただけると幸いです。

ネットなどを見ながらVBAにチャレンジしています。

仕事で在庫の集計表を作っています。

添付ファイル（上）のような表でAL列からBA列まで3行目から約10000行目(毎回変わります）までにSUMIFSを使いそれぞれの集計をしています。

添付ファイル（下）zaikoのシートは元データが入っています。

c = Sheets("home").Cells(Rows.Count, "N").End(xlUp).Row

For T = 38 To 53
For d = 3 To c

Sheets("home").Cells(d, T) = WorksheetFunction.SumIfs(Sheets("zaiko").Columns("G:G"), Sheets("zaiko").Columns("C:C"), Sheets("home").Cells(d, 14), Sheets("zaiko").Columns("A:A"), Sheets("home").Cells(1, T))

Next d
Next T

上記コードで計算はできたのですが約13分かかってしましました。

もっと早く計算する方法はありますか？

SUMIFSにこだわりはないので別の計算方法でも構いません。ただし在庫がないときは0と表示されないといけません。

home のシートの1行目AL:BAは店舗コードになります。

ご教授のほどよろしくお願いいます。

質問者からの補足コメント

• 初心者なもので質問してすいません。
  
  上記のコードをどう組み込めばいいんでしょうか？

  No.2の回答に寄せられた補足コメントです。 補足日時：2016/05/07 17:16

No.1 ベストアンサー 回答者： tom04 回答日時： 2016/05/07 16:33

こんにちは！

＞3行目から約10000行目・・・

1セルずつループさせるとかなりの時間を要するはずです。
↓のような感じではどうでしょうか？

Sub Sample1()
Dim lastRow As Long, wS As Worksheet
Set wS = Worksheets("zaiko")
With Worksheets("home")
lastRow = .Cells(Rows.Count, "N").End(xlUp).Row
With Range(.Cells(3, "AL"), .Cells(lastRow, "BA"))
.Formula = "=SUMIFS(zaiko!$G:$G,zaiko!$C:$C,$N3,zaiko!$A:$A,AL$1)"
.Value = .Value
End With
End With
End Sub

※　ExcelでできることはExcelに任せて（数式をそのまま使って）
あとは値にします。

※　細かい検証はしていませんので
思い通りの動きにならなかったらごめんなさいね。m(_ _)m

この回答へのお礼

ありがとうございました。無事解決しました。わかりやすくコードを作ってもらえて助かりました。

お礼日時：2016/05/09 17:33

No.4 回答者： soixante 回答日時： 2016/05/07 18:53

わたしに誤解があったら申し訳ないのですが、

在庫シートが集計すべきデータで、ホームシートが集計結果を出すシートですよね。
ホームシートに、商品コードごと　かつ　店番ごと　の在庫数を算出するという。

原始的ですが、以下のようにやってみました。ホームではなく、在庫データをループさせています。
データ数が分からないので、ホーム、在庫データとも1万件でやってみました。
もっといい方法もあるかと思いますがよろしければ一度どうぞ。

'---------------------------------------------------
Sub Shukei()

'***　変数宣言　***
Dim WsH As Worksheet, WsZ As Worksheet
Dim WSF As Object
Set WsH = Worksheets("home")
Set WsZ = Worksheets("zaiko")
Set WSF = Application.WorksheetFunction

Dim r As Long, c As Integer
Dim LstRow As Long, Zaiko As Long
Dim SCode As String, MiseCode As Integer
Dim SRow As Long, MiseCol As Integer

'***　在庫シートの最終行を取得　***
LstRow = WsZ.Cells(Rows.Count, 1).End(xlUp).Row

Application.ScreenUpdating = False

'***　在庫シートの2行目から最終行までループ　***
For r = 2 To LstRow
SCode = WsZ.Cells(r, 3).Value '商品コード。在庫のC列
MiseCode = WsZ.Cells(r, 1).Value '店コード。在庫のA列
Zaiko = WsZ.Cells(r, 7).Value '在庫数。在庫のG列

SRow = WSF.Match(SCode, WsH.Columns(14), 0) '該当の商品コードがホームシートN列の何行目にあるか
MiseCol = WSF.Match(MiseCode, WsH.Rows(1), 0) '該当の店番がホームシート1行目の何列目にあるか

WsH.Cells(SRow, MiseCol).Value = WsH.Cells(SRow, MiseCol).Value + Zaiko 'ホームシートの該当セルに在庫数を加算
Next r

Application.ScreenUpdating = True

Set WSF = Nothing
Set WsH = Nothing
Set WsZ = Nothing

MsgBox "End."

End Sub
'---------------------------------------------------------------------------------

No.3 回答者： 30246kiku 回答日時： 2016/05/07 18:00

雰囲気以下でどうなりますか

元のファイルをコピーして、
標準モジュールに以下を記述して実行すると････

未実行なので、おかしかったらごめんなさい


やっていることは、
"zaiko" シートを初めにまとめておきます
商品コード & タブ & 店舗コード　の文字列で在庫数を Sum しておきます

覚えたら、"home" シートに移って
AL1 ～ BA1 の店舗コードと位置（AL 列が 1 ～ ）を覚えてから、
N 列 & タブ & 店舗コード を生成して、求めていた Sum 値を引っ張る


実行結果を教えてください


Option Explicit

Public Sub Samp1()
　　Dim dic As Object, dicE As Object
　　Dim vA As Variant, v As Variant
　　Dim iA() As Long
　　Dim sS As String
　　Dim i As Long, j As Long
　　Const CSEP As String = vbTab

　　Set dic = CreateObject("Scripting.Dictionary")
　　Set dicE = CreateObject("Scripting.Dictionary")

　　With Worksheets("zaiko")
　　　　For i = 2 To .Cells(Rows.Count, "C").End(xlUp).Row
　　　　　　sS = .Cells(i, "C").Value & CSEP & .Cells(i, "A").Value
　　　　　　dic(sS) = dic(sS) + .Cells(i, "G").Value
　　　　Next
　　End With

　　With Worksheets("home")
　　　　vA = .Range("AL1:BA1").Value
　　　　For j = 1 To UBound(vA, 2)
　　　　　　dicE(vA(1, j)) = j
　　　　Next
　　　　With .Range("N3", .Cells(Rows.Count, "N").End(xlUp))
　　　　　　ReDim iA(1 To .Rows.Count, 1 To dicE.Count)
　　　　　　vA = .Value
　　　　　　For i = 1 To UBound(vA)
　　　　　　　　For Each v In dicE.Keys
　　　　　　　　　　sS = vA(i, 1) & CSEP & v
　　　　　　　　　　iA(i, dicE(v)) = dic(sS)
　　　　　　　　Next
　　　　　　Next
　　　　　　With .Offset(, Range("AL1").Column - .Column)
　　　　　　　　.Resize(, dicE.Count).Value = iA
　　　　　　End With
　　　　End With
　　End With

　　Set dic = Nothing
　　Set dicE = Nothing
End Sub



※ 以下参考になるところがあれば

Sub macro() Application.Calculation = xlC
http://detail.chiebukuro.yahoo.co.jp/qa/question …

とか

マクロ 関数関連 スピードアップ お世話になりま
http://detail.chiebukuro.yahoo.co.jp/qa/question …

No.2 回答者： Hypnomatic 回答日時： 2016/05/07 16:46

セルに１個１個書き込むよりかは、一度、配列に代入をして、まとめて反映するほうが高速です。

下記のような方法です。
Dim c As Variant
C = Range("A1:A1000")
Range("B1:B1000") = C