標題: [發問] 求助用程式幫忙合併資料數據 [打印本頁]

---

作者: glriffy_su    時間: 2013-8-8 20:25     標題: 求助用程式幫忙合併資料數據

感謝大大提供方法 (如附檔[attach]15732[/attach])

不然每天要花一堆時間合併並算出數據  會發瘋   感謝先

---

作者: glriffy_su    時間: 2013-8-8 20:35

回復 1# glriffy_su


    可以用MAIL寄給我嗎  超級感謝  : [email protected]

---

作者: p212    時間: 2013-8-8 22:23

回復 1# glriffy_su
請上傳參考檔案（不是貼圖哦！），以利解題，謝謝！

---

作者: Hsieh    時間: 2013-8-8 23:15

回復 1# glriffy_su
試試看

1. Sub ex()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. Set d1 = CreateObject("Scripting.Dictionary")
   
4. Set d2 = CreateObject("Scripting.Dictionary")
   
5. With 工作表1 '來源工作表
   
6.   r = 3
   
7.   Do Until .Cells(r, 2) = ""
   
8.      mystr = .Cells(r, 1).Text & "," & Split(.Cells(r, 2), ".")(0)
   
9.      d1(mystr) = d1(mystr) + .Cells(r, 3)
   
10.      d2(mystr) = d2(mystr) + .Cells(r, 3)
    
11.      For Each a In .Range(.[E2], .[E2].End(xlToRight))
    
12.        d(mystr & "," & a) = d(mystr & "," & a) + Cells(r, a.Column)
    
13.      Next
    
14.      r = r + 1
    
15.   Loop
    
16. End With
    
17. With 工作表2 '目標工作表
    
18. r = 3
    
19.   For Each ky In d1.keys
    
20.     .Cells(r, 1).Resize(, 2) = Split(ky, ",")
    
21.     .Cells(r, 3) = d1(ky)
    
22.     .Cells(r, 4) = d2(ky)
    
23.     For Each a In .Range(.[E2], .[E2].End(xlToRight))
    
24.        .Cells(r, a.Column) = d(ky & "," & a)
    
25.     Next
    
26.     r = r + 1
    
27.   Next
    
28. End With
    
29. End Sub

複製代碼

---

作者: glriffy_su    時間: 2013-8-10 20:58

回復 4# Hsieh


    大大  太感謝您了  剩下的我自己修改一下  再次感謝

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)