標題: 有高手可以幫我簡化一下嗎? [打印本頁]

---

作者: am0251    時間: 2011-6-19 17:20     標題: 有高手可以幫我簡化一下嗎?

我做了一個簡單的統計程式,對比下"A2"的內容跟"A3"的內容是否一致,如果是的話,那麼"B2"跟"B3"的數值就會相加,之後"A3"跟"B3"就會刪除,如果是"否"的話就向下一格,資料少的話還好,如困資料多過500之後就會非常的慢(很有可能我的電腦太舊了),在我有錢換新電腦之前,有高手可以幫我簡化一下嗎?謝謝!!

1. Sub Test()
   
2. Dim z As Integer
   
3. z = 2
   
4. 
   
5. Do While Range("A" & z).Value <> ""
   
6. 
   
7. If Range("A" & z).Value = Range("A" & (z + 1)).Value Then
   
8.    Range("B" & z).Value = Range("B" & z).Value + Range("B" & (z + 1)).Value
   
9.        Range("A" & (z + 1), "B" & (z + 1)).Delete Shift:=xlUp
   
10. Else
    
11.     z = z + 1
    
12.    
    
13. End If
    
14. 
    
15. Loop
    
16. 
    
17. If Range("A2").Value = "-" Then Range("A2:B2").Delete Shift:=xlUp
    
18. 
    
19. End Sub

複製代碼

---

作者: oobird    時間: 2011-6-19 22:18

1. Sub Test()
   
2. Dim a, d As Object, i&
   
3. a = Range([A2], [b65536].End(3))
   
4. Set d = CreateObject("Scripting.Dictionary")
   
5. For i = 1 To UBound(a)
   
6. d(a(i, 1)) = d(a(i, 1)) + a(i, 2)
   
7. Next
   
8. Range([A2], [b65536].End(3)) = ""
   
9. [A2].Resize(d.Count, 1) = Application.Transpose(d.keys)
   
10. [b2].Resize(d.Count, 1) = Application.Transpose(d.items)
    
11. If [A2] = "-" Then [A2:B2].Delete (2)
    
12. End Sub

複製代碼

---

作者: am0251    時間: 2011-6-20 16:57

哇~~!!好厲害啊~~!!真的快很多,不過小弟比較笨,有很多指令都看不明白,大大介意給我介紹一下功能跟原理嗎?謝謝!!

---

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