[發問] excel vba資料加總的寫法

想請教大家

現在有一份資料
要如何利用 vba來計算出想要的結果(不是用excel喔~)

原始資料集資料結果如附件!!
目前只想到用sumif,可是蘭嶼列都要各自加總一次...
迴圈的話也不知道要如何下手

煩請幫幫忙

count.rar (7.35 KB)

樓主熱帖

POP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 246
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-12

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

2^#

發表於 2013-1-31 09:48 | 只看該作者

本帖最後由 Hsieh 於 2013-2-1 00:45 編輯

回復 1# smartpearl
資料只有2種Item嗎?

Sub ex()
Dim Ay(2), MyID%, Ary(2)
Set d = CreateObject("Scripting.Dictionary")
ar = Range("A1").CurrentRegion '將表格寫入陣列
i = 2 '第2列開始
Do
j = 4 '第4欄開始
Do
MyID = IIf(ar(i, 2) = "Add", 0, 1) '第2欄如果是Add就用0否則用1作為陣列索引
Ay(MyID) = Ay(MyID) + ar(i, j) '將陣列值相加
j = j + 1 '欄位加1
Loop Until j > UBound(ar, 2) Or TypeName(Cells(1, j).Value) = "String" '直到欄位大過表格欄位或是第一列的值是字串(避免第2次執行會計算到原本新增的統計位置)
Cells(i, j).Resize(, 2) = Ay '資料列的後面欄位加入加總值
Erase Ay
i = i + 1 '列數加1
Loop Until i > UBound(ar, 1) Or Cells(i, 1) = "" '直到列數大過表格列數或第1欄為空白
Cells(i, j) = "=SUM(R2C:R[-1]C)": Cells(i + 1, j + 1) = "=SUM(R2C:R[-1]C)" '表格右下方寫入公式
Cells(1, j).Resize(, 2) = Array("Count_Add", "Count_None") '寫入標題
j = 4
Do
i = 2
Do
d(ar(i, 2)) = ar(i, j) + d(ar(i, 2)) '以第2欄內容為字典索引，分別計算個索引加總
i = i + 1
Loop Until i > UBound(ar, 1) Or Cells(i, 1) = "" '直到列數大過表格列數或第1欄為空白
For Each ky In d.keys '取出每個字典索引
Ay(s) = d(ky)
s = s + 1
Next
Cells(i, j).Resize(3, 1) = Application.Transpose(Ay) '表格下方寫入加總資料
Erase Ay: s = 0: d.RemoveAll '清除陣列與字典內容
j = j + 1 '欄數加1
Loop Until j > UBound(ar, 2) Or TypeName(Cells(1, j).Value) = "String" '直到欄位大過表格欄位或是第一列的值是字串(避免第2次執行會計算到原本新增的統計位置)
Cells(i + 2, 4).Resize(, Range("A1").CurrentRegion.Columns.Count - 3) = "=R[-1]C-R[-2]C" '寫入加總值差額公式
Cells(i, 3) = "Sub_Add": Cells(i + 1, 3) = "Sub_None": Cells(i + 2, 3) = "Total" '寫入標題
End Sub