麻辣家族討論版版 » Excel程式區 » 如何用VBA將SHEET1內相同的資料合併計算後複製到SHEET2

返回列表下一主題上一主題發帖

[發問] 如何用VBA將SHEET1內相同的資料合併計算後複製到SHEET2

中學生 Rank: 2

帖子: 55
主題: 17
精華: 0
積分: 79
點名: 0
作業系統: XP
軟體版本: office2007
閱讀權限: 20
性別: 男
註冊時間: 2013-7-17
最後登錄: 2020-12-31

1^# 跳轉到 » 正序看帖

字體大小: tT

發表於 2013-7-24 18:00 | 只看該作者

[發問] 如何用VBA將SHEET1內相同的資料合併計算後複製到SHEET2

如何用VBA將SHEET1內相同的資料合併計算後複製到SHEET2，並依序排列：
例如：SHEET1內的
A1為摘要：代管費收入，B1為金額：10000
A2為摘要：磁扣收入：B2：為金額500
A3為摘要：代管費收入，B3為金額：1500
A4為摘要：磁扣收入：B4：為金額500

希望在SHEET1輸入完畢後，在SHEET2能自動整合為
A1為摘要：代管費收入，B1為金額：11500( 合併SHEET1的摘要，並加總)
A2為摘要：磁扣收入：B2：為金額1000()( 合併SHEET1的摘要，並加總)

煩請大大解惑，不勝感激.....
煩請附帶告知解惑之程式要貼在SHEET1還是SHEET2還是模組還是WORKBOOK裡

樓主熱帖

收藏

你猜!!

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

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

9^#

發表於 2013-8-10 14:23 | 只看該作者

回復 8# bear0925900003
用資料->合併彙算的指令試試看

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

中學生 Rank: 2

帖子: 55
主題: 17
精華: 0
積分: 79
點名: 0
作業系統: XP
軟體版本: office2007
閱讀權限: 20
性別: 男
註冊時間: 2013-7-17
最後登錄: 2020-12-31

8^#

發表於 2013-8-9 16:55 | 只看該作者

回復 3# GBKEE

請問老師，您給的程式是無限的往下篩選複製，現有幾個疑問想請教：
1.如果只是要固定範圍的寫法(EX：A1~B10這個範圍)，那該如何修正本程式
2.如果為多頁且固定範圍的語法又該如何修正(EX:sheets1，sheets2的A1~B10合併複製到sheet3的B1~C10)

小弟試了多次始終無法修改成功，還請賜教，無限感激

你猜!!

中學生 Rank: 2

帖子: 55
主題: 17
精華: 0
積分: 79
點名: 0
作業系統: XP
軟體版本: office2007
閱讀權限: 20
性別: 男
註冊時間: 2013-7-17
最後登錄: 2020-12-31

7^#

發表於 2013-8-3 17:51 | 只看該作者

回復 6# GBKEE

原來是這樣,董了,謝謝老師

你猜!!

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

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

6^#

發表於 2013-8-3 17:27 | 只看該作者

回復 5# bear0925900003

Option Explicit
Sub Ex()
Dim D As Object, i As Integer
Set D = CreateObject("SCRIPTING.DICTIONARY")
With Sheets("SHEET1") ''工作表物件
i = 1
Do While .Cells(i, "A") <> "" '工作表.物件加. 為此物件的子物件,方法,屬性
'Do While .Range("A" & i) <> "" '也可以用 Range
D(.Cells(i, "A").Value) = D(.Cells(i, "A").Value) + .Cells(i, "B")
i = i + 1
Loop
End With
With Sheets("SHEET2") ''工作表物件
i = 1
Do While .Cells(i, "A") <> "" '工作表.物件加. 為此物件的子物件,方法,屬性
'Do While .Range("A" & i) <> "" '也可以用 Range
D(.Cells(i, "A").Value) = D(.Cells(i, "A").Value) + .Cells(i, "B")
i = i + 1
Loop
End With
If D.Count > 1 Then
With Sheets("SHEET3")
.[A1].Resize(D.Count) = Application.Transpose(D.KEYS)
.[B1].Resize(D.Count) = Application.Transpose(D.ITEMS)
End With
End If
End Sub

複製代碼

Sub Ex_a()
Dim D As Object, i As Integer, e As Variant
Set D = CreateObject("SCRIPTING.DICTIONARY")
For Each e In Array(Sheets("SHEET1"), Sheets("SHEET2"), Sheets("SHEET3"))
With e
i = 1
Do While .Cells(i, "A") <> "" '工作表.物件加. 為此物件的子物件,方法,屬性
'Do While .Range("A" & i) <> "" '也可以用 Range
D(.Cells(i, "A").Value) = D(.Cells(i, "A").Value) + .Cells(i, "B")
i = i + 1
Loop
End With
Next
If D.Count > 1 Then
With Sheets("SHEET4")
.[A1].Resize(D.Count) = Application.Transpose(D.KEYS)
.[B1].Resize(D.Count) = Application.Transpose(D.ITEMS)
End With
End If
End Sub

複製代碼

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

中學生 Rank: 2

帖子: 55
主題: 17
精華: 0
積分: 79
點名: 0
作業系統: XP
軟體版本: office2007
閱讀權限: 20
性別: 男
註冊時間: 2013-7-17
最後登錄: 2020-12-31

5^#

發表於 2013-8-3 10:13 | 只看該作者

回復 3# GBKEE

請問老師若要改成SHEET1、SHEET2合併到SHEET3該如何修改

你猜!!

中學生 Rank: 2

帖子: 55
主題: 17
精華: 0
積分: 79
點名: 0
作業系統: XP
軟體版本: office2007
閱讀權限: 20
性別: 男
註冊時間: 2013-7-17
最後登錄: 2020-12-31

4^#

發表於 2013-7-26 14:41 | 只看該作者

感謝大大無私的分享，問題已解決，無盡感恩!!

你猜!!

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

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

3^#

發表於 2013-7-25 06:55 | 只看該作者

回復 1# bear0925900003
物件有指明父層程式碼可任意擺

Option Explicit
Sub Ex()
Dim D As Object, i As Integer, A
Set D = CreateObject("SCRIPTING.DICTIONARY")
With Sheets("SHEET1") ''工作表物件
i = 1
Do While .Cells(i, "A") <> "" '工作表.物件加. 為此物件的子物件,方法,屬性
'Do While .Range("A" & i) <> "" '也可以用 Range
D(.Cells(i, "A").Value) = D(.Cells(i, "A").Value) + .Cells(i, "B")
i = i + 1
Loop
End With
If i > 1 Then
With Sheets("SHEET2")
.[A1].Resize(D.Count) = Application.Transpose(D.KEYS)
.[B1].Resize(D.Count) = Application.Transpose(D.ITEMS)
End With
End If
End Sub

複製代碼

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

大學生 Rank: 4

帖子: 1018
主題: 15
精華: 0
積分: 1058
點名: 0
作業系統: win7 32bit
軟體版本: Office 2016 64-bit
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2012-5-9
最後登錄: 2022-9-28

2^#

發表於 2013-7-24 20:35 | 只看該作者

回復 1# bear0925900003
不用VBA的話，可以直接輸入公式就會幫你計算了，
在Sheet2的 B1輸入 =SUM(Sheet1!B1,Sheet1!B3)
B2輸入 =SUM(Sheet1!B2,Sheet1!B4)

靜思自在 : 君子如水，隨方就圓，無處不自在。

返回列表下一主題上一主題