[[20050616194542]]　『SUMPRODUCTに代わるVBAって可能ですか？』（ワンコゥ）　ページの最後に飛ぶ

『SUMPRODUCTに代わるVBAって可能ですか？』（ワンコゥ）

VBAのことをよくわかっていません。
できるなら勉強と考えておりますが…。

あるシート（入力表）から複数の情報をSUMPRODUCTで別のシート（計算）に抽出して計算しています。
情報量が多すぎて計算に５分くらいかかってしまいます。（10,000行から抽出）
現在、手動で再計算が必要なときだけやっていますが…
SUMPRODUCTに代わるうまい方法がないものでしょうか？

＜入力表＞

　　Ａ　　Ｂ　　　Ｃ　　　Ｄ　　　　　　Ｅ　　　　　Ｆ

1　年　　月　　　場所　　　種別　　　予算内/外　金額

2　2005　　1　　　便所　モップ　　　　 1　　　　　1200

3　2005　　1　　　風呂　　　タワシ　　　 0　　　　　300

4　2005　　2　　　風呂　　　洗剤 1　　　　　200

5　2005　　3　　　台所　　　洗剤 1　　　　　600

6　2005　　4　　　風呂　　　洗剤 0　　　　　1360

7　2005　　5　　　庭　　　ホウキ 1　　　　　500

8　2005　　5 便所　　　タワシ 1　　　　　250

＜計算表＞

　　Ａ　　Ｂ　　　Ｃ　　　Ｄ　　　Ｅ　　　Ｆ

1　種類　　合計　　　4月　 5月　　　 6月　7月　

2　便所　　

3　モップ　　5000　　　0　　　　500　　　　200
　

4　たわし　　3600　　　200　　　400 400　　　　　

5　洗剤　　　8200　　　　0 　 700 400　　　　　

6　ほうき　　2200　　　500　　　　0 1200　　　　　

7　風呂　　

8　モップ　　6500 100　　　タワシ　 800　　　　　

Ｂの列は単純にSUMでよいとして
問題はC,D,E,F…です。

例えばＣ３には
=SUMPRODUCT((入力表!$B$2:$B$10000=4)*(入力表!$C$2:$C$10000="便所")*(入力表!$D$2:$D$10000="モップ")*(入力表!$E$2:$E$10000=1)*(入力表!$H$2:$H$10000))

これを他のセルにも同じようにして反映させ、計算表の5000セルにいろいろと計算させてます。（他のシートからも引っ張ってきている）
VBAではこうした自動計算は可能でしょうか？
可能であれば勉強して作成したいと考えております。
ヒントや書籍等も教えていただければ幸いです。
乱文失礼しました。
Excel2000
Win2000

 おはようございます。
もしも私がこのような場面に直面したとしたら、多分以下の様にすると思います。
先ず、今、問題になっているのはSUMPRODUCT関数では無くてデータ数が多いからではないのですか？
つまり、そのデータから重複を除いて集計してあげればいいのではないのですか？
Sheet1のフィールドが以下の様になっていたとして
A　　　　 B　　　　 C　　　  D　　　　   E　　　　　　　　　　　　　　H
年	月	場所	種別	予算内/外			金額
重複を除いた集計をSheet2に書き出します。そのSheet2を元に計算されてはどうですか？
データの種類にもよると思いますが、40000件のレコードでテストした結果、私のオンボロPCで約5秒ほどでした。
Option Explicit
Sub てすと()
Dim MyTbl As Range
Dim MyA As Variant
Dim MyB As Variant
Dim MyC As Variant
Dim ii As Long, i As Long
Dim MyTimer As Single
MyTimer = Timer
With Sheets("Sheet1")
    Set MyTbl = .Range("A1", .Range("A65536").End(xlUp)).Resize(, 5)
    MyA = MyTbl.Value
    MyC = MyTbl.Offset(, 7).Resize(, 1).Value
End With
With Sheets("Sheet2")
    .Cells.ClearContents
    MyTbl.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("A1"), Unique:=True
    MyB = .Range("A1", .Range("A65536").End(xlUp)).Resize(, 6).Value
    For ii = 2 To UBound(MyB, 1)
        For i = 2 To UBound(MyA, 1)
            If MyB(ii, 1) = MyA(i, 1) And MyB(ii, 2) = MyA(i, 2) And _
                MyB(ii, 3) = MyA(i, 3) And MyB(ii, 4) = MyA(i, 4) And MyB(ii, 5) = MyA(i, 5) Then
                If IsNumeric(MyC(i, 1)) Then
                    MyB(ii, 6) = MyB(ii, 6) + MyC(i, 1)
                End If
            End If
        Next
    Next
    .Range("A1").Resize(UBound(MyB, 1), UBound(MyB, 2)).Value = MyB
End With
Erase MyA, MyB, MyC
Set MyTbl = Nothing
MyTimer = Timer - MyTimer
MsgBox Format(MyTimer, "###0.000") & "秒　抽出完了!!"
End Sub
（SoulMan）

コメント返信：

[ 一覧(最新更新順) ]

[[20050616194542]] 『SUMPRODUCTに代わるVBAって可能ですか？』（ワンコゥ） ページの最後に飛ぶ

[[20050616194542]]　『SUMPRODUCTに代わるVBAって可能ですか？』（ワンコゥ）　ページの最後に飛ぶ