用VBA來執行SUMPRODUCT多條件統計 - Excel程式區

[發問] 用VBA來執行SUMPRODUCT多條件統計

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

2^# 跳轉到 »

發表於 2013-4-2 18:05 | 只看該作者

回復 1# b9208
試試看

Option Explicit
Sub Ex()
Dim D(1 To 2) As Object, i As Integer, M As String
Dim R As Integer, C As Integer, A As Range
Set D(1) = CreateObject("scripting.dictionary") '字典物件
Set D(2) = CreateObject("scripting.dictionary")
With Sheets("明細")
i = 6
Do While .Cells(i, "d") <> ""
M = .Cells(i, "D") & Mid(.Cells(i, "E"), 1, 4) & .Cells(i, "F")
D(1)(M) = D(1)(M) + 1 '全部
M = .Cells(i, "D") & Mid(.Cells(i, "E"), 1, 4) & .Cells(i, "F") & .Cells(i, "L")
D(2)(M) = D(2)(M) + 1 '區域
i = i + 1
Loop
End With
With Sheets("統計")
For Each A In .Range("F3:J12,F18:J27,F33:J42,F48:J57").Areas '修正為你的全部及區域的範圍
With A
For R = 3 To .Rows.Count - 1
For C = 2 To .Columns.Count
If .Cells(1) = "全部" Then '全部
.Cells(R, C) = D(1)(.Cells(R, 1) & Mid(.Cells(1, C), 1, 4) & .Cells(2, C))
Else '區域
.Cells(R, C) = D(2)(.Cells(R, 1) & Mid(.Cells(1, C), 1, 4) & .Cells(2, C) & .Cells(1))
End If
Next
Next
For C = 2 To .Columns.Count
.Cells(.Rows.Count, C).FormulaR1C1 = "=SUM(R[-" & .Rows.Count - 3 & "]C:R[-1]C)" '公式
.Cells(.Rows.Count, C) = .Cells(.Rows.Count, C).Value
Next
End With
Next
End With
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

靜思自在 : 發脾氣是短暫的發瘋。