Board logo

標題: 如何改善這段程式，讓執行效率提升？ [打印本頁]
作者: av8d    時間: 2015-4-21 19:16     標題: 如何改善這段程式，讓執行效率提升？

  1. Sub test()
  2. '年度分析，開銷前3名
  3.     Application.ScreenUpdating = False
  4.     W = [W]
  5.     r = [A1].CurrentRegion.Rows.Count
  6.     Range("B7:M" & r).ClearContents
  7.     Range("B2:M3").ClearContents
  8.     myyear = [A1].Value
  9.     For c = 2 To 13
  10.         mymonth = myyear & "/" & Trim(Cells(1, c).Value)
  11.         income = 0
  12.         expense = 0
  13.         pay = 0
  14.         v = 11
  15.         With Sheets("DataCopy")
  16.             er = .[A100000].End(3).Row
  17.             For r = 2 To er
  18.                 If myyear & "/" & Format(.Cells(r, 1).Value, "m月份") = mymonth Then
  19.                     money = Val(.Cells(r, 3).Value)
  20.                     Select Case .Cells(r, 2).Value
  21.                         Case "收入": income = income + money
  22.                         Case "支出": expense = expense + money
  23.                         Case "分期付款": expense = expense + money: pay = pay + 1
  24.                     End Select
  25.                     myitem = .Cells(r, 4).Value
  26.                     If .Cells(r, 2).Value <> "收入" Then
  27.                         Set cell = Columns(c + 1).Find(myitem)
  28.                         If Not cell Is Nothing Then
  29.                             cell.Offset(, -1).Value = cell.Offset(, -1).Value + money
  30.                         Else
  31.                             Cells(v, c).Value = money
  32.                             Cells(v, c + 1).Value = .Cells(r, 4).Value
  33.                             v = v + 1
  34.                         End If
  35.                     End If
  36.                 End If
  37.             Next r
  38.             If Cells(11, c) <> "" Then
  39.                 Set rng = Range(Cells(11, c), Cells(v - 1, c + 1))
  40.                 rng.Sort key1:=Cells(11, c), order1:=xlDescending
  41.                 X = 0
  42.                 v = 11
  43.                 Do Until Cells(v, c).Value = ""
  44.                     If InStr(W, Cells(v, c + 1)) = 0 Then
  45.                         If X < 3 Then
  46.                             X = X + 1
  47.                             Cells(X + 6, c).Value = X & ". " & Cells(v, c + 1).Value & " / " & Cells(v, c).Value & "元"
  48.                         End If
  49.                     End If
  50.                     Cells(v, c).Value = v - 10 & ". " & Cells(v, c + 1).Value & " / " & Cells(v, c).Value & "元"
  51.                     Cells(v, c + 1).Value = ""
  52.                     v = v + 1
  53.                 Loop
  54.             End If
  55.         End With
  56.         Cells(2, c).Value = IIf(income <> 0, income, "")
  57.         Cells(3, c).Value = IIf(expense <> 0, expense, "")
  58.         Cells(10, c).Value = pay
  59.     Next c
  60.     Application.ScreenUpdating = True
  61. '自動換行
  62.     Rows("7:100000").EntireRow.AutoFit
  63.     Application.ScreenUpdating = True
  64. End Sub
複製代碼
以上是某位老師撰寫，有點忘了是誰(失禮了)，原本都用XP的Excel執行，效率都還OK，
換成2010後，執行以後會變得非常非常的慢，不知道有沒有辦法改善，謝謝！
作者: PKKO    時間: 2015-4-21 20:01

回復 1# av8d


    流程的部分我沒有分析,但我確定的是可以用陣列會執行的更快
因為陣列的運作速度會比讀取CELLS快N倍

在開頭的地方先
AR=[a1].currentregion'此行風險在於中斷的儲存格,若有中斷的儲存格請用下方
AR=[a1].resize(x,y)'可自訂陣列大小
之後AR(1,1) 就會等於 cells(1,1)=>因此將程式碼取代即可,  而.value的部分則可刪除

with 的部分一樣用AR2=.[a1].currentregion'即可,AR2(1,1)=.cells(1,1)
但後面sort的部分要保留原本的CELLS才不會有問題
以及最後輸出的.cells.value因為要輸出,當然不可取代為陣列



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