- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 41
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2025-2-16
               
|
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
|
|
發表於 2013-1-30 22:15
| 
