返回列表 上一主題 發帖

有高手可以幫我簡化一下嗎?

am0251

帖子
65 
主題
11 
精華
0 
積分
83 
點名
0  
作業系統
Window 7 
軟體版本
2007 
閱讀權限
20 
註冊時間
2010-5-4 
最後登錄
2012-5-21 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2011-6-19 17:20 | 只看該作者

有高手可以幫我簡化一下嗎?

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

  5. Do While Range("A" & z).Value <> ""

  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

  15. Loop

  17. If Range("A2").Value = "-" Then Range("A2:B2").Delete Shift:=xlUp

  19. End Sub
複製代碼
收藏 分享
50 字節以內
不支持自定義 Discuz! 代碼

oobird
　頭銜: 街友一族

超級版主Rank: 8Rank: 8

帖子
1572 
主題
16 
精華
2 
積分
1521 
點名
0  
作業系統
xp 
軟體版本
office 2003 
閱讀權限
150 
性別
男 
註冊時間
2010-5-1 
最後登錄
2016-1-13 

論壇貢獻勳章
2#
發表於 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
複製代碼

TOP

am0251

帖子
65 
主題
11 
精華
0 
積分
83 
點名
0  
作業系統
Window 7 
軟體版本
2007 
閱讀權限
20 
註冊時間
2010-5-4 
最後登錄
2012-5-21 
3#
發表於 2011-6-20 16:57 | 只看該作者
哇~~!!好厲害啊~~!!真的快很多,不過小弟比較笨,有很多指令都看不明白,大大介意給我介紹一下功能跟原理嗎?謝謝!!
50 字節以內
不支持自定義 Discuz! 代碼

TOP

        靜思自在 : 忘功不忘過，忘怨不忘恩。
返回列表 上一主題