Board logo

標題: [發問] 迴圈程式碼,請問是否有更快的執行方式?? [打印本頁]

作者: swtseng    時間: 2012-10-26 14:36     標題: 迴圈程式碼,請問是否有更快的執行方式??

請問大大們,如達到下面迴圈程式碼,能夠有更快的執行方式嗎??
(a1~a65535都有數字,判斷是否在範圍中,如果不在範圍中則複製空白)


sub xx()
Dim my_min%, my_max%
my_min = 30
my_max = 50
Sheet1.Cells(27) = "Num"
Sheet1.Cells(28) = "x(1)"
Sheet1.Cells(29) = "y(2)"
Sheet1.Cells(30) = "iv(3)"
Sheet1.Cells(31) = "vf(4)"
For i = 2 To 65535
   Sheet1.Cells(i, 27) = Sheet3.Cells(i, 1)
   If Sheet3.Cells(i, 6) > my_min And Sheet3.Cells(i, 6) < my_max Then
    Sheet1.Cells(i, 28) = Sheet3.Cells(i, 3)
    Sheet1.Cells(i, 29) = Sheet3.Cells(i, 4)
    Sheet1.Cells(i, 30) = Sheet3.Cells(i, 5)
    Sheet1.Cells(i, 31) = Sheet3.Cells(i, 6)
  End If
Next i
end xx
作者: c_c_lai    時間: 2012-10-26 14:59

回復 1# swtseng
  1. For i = 2 To Sheet1.Cells(2, 27).End(xlDown).Row
  2.     .............
  3. Next i
複製代碼

作者: mark15jill    時間: 2012-10-26 16:45

本帖最後由 mark15jill 於 2012-10-26 16:46 編輯
請問大大們,如達到下面迴圈程式碼,能夠有更快的執行方式嗎??
(a1~a65535都有數字,判斷是否在範圍中,如 ...
swtseng 發表於 2012-10-26 14:36
  1. '簡易判斷
  2. kk = 工作表2.Range("c1").CurrentRegion.Rows.Count
  3.     For sj = 1 To kk
  4.        For uu = 8 To 11
  5.             工作表1.Cells(sj, uu) = 工作表2.Cells(sj, uu - 5)
  6.        Next
  7.     Next
複製代碼
sj =判斷行數
uu=從 N 到 K 欄 ( 在此以 8~11欄 為例)
作者: stillfish00    時間: 2012-10-26 17:19

請問大大們,如達到下面迴圈程式碼,能夠有更快的執行方式嗎??
(a1~a65535都有數字, ...
swtseng 發表於 2012-10-26 14:36


先copy到同一個sheet再做比較 , 試看看:
  1. Sub test()
  2.     Application.ScreenUpdating = False
  3.    
  4.     Dim my_min%, my_max%
  5.     my_min = 30
  6.     my_max = 50
  7.    
  8.     sheet1.Range("AA:AA") = sheet3.Range("A:A").Value
  9.     sheet1.Range("AB:AE") = sheet3.Range("C:F").Value
  10.    
  11.     sheet1.Cells(27) = "Num"
  12.     sheet1.Cells(28) = "x(1)"
  13.     sheet1.Cells(29) = "y(2)"
  14.     sheet1.Cells(30) = "iv(3)"
  15.     sheet1.Cells(31) = "vf(4)"
  16.    
  17.     Dim n As Range
  18.     For Each n In sheet1.Range("AE2:AE65535")
  19.         If n.Value > my_min And n.Value < my_max Then
  20.         Else
  21.             n.Offset(, -3).Resize(, 4).ClearContents
  22.         End If
  23.     Next n
  24.    
  25.     Application.ScreenUpdating = True
  26. End Sub
複製代碼

作者: GBKEE    時間: 2012-10-26 17:27

回復 1# swtseng      
試試看
  1. Option Explicit
  2. Sub xx()
  3. Dim my_min%, my_max%, i&, Ar(2 To 65535, 1 To 5)
  4. my_min = 30
  5. my_max = 50
  6. Sheet1.Cells(27) = "Num"
  7. Sheet1.Cells(28) = "x(1)"
  8. Sheet1.Cells(29) = "y(2)"
  9. Sheet1.Cells(30) = "iv(3)"
  10. Sheet1.Cells(31) = "vf(4)"
  11. For i = 2 To 65535
  12.    Ar(i, 1) = Sheet3.Cells(i, 1)
  13.    If Sheet3.Cells(i, 6) > my_min And Sheet3.Cells(i, 6) < my_max Then
  14.     Ar(i, 2) = Sheet3.Cells(i, 3)
  15.     Ar(i, 3) = Sheet3.Cells(i, 4)
  16.     Ar(i, 4) = Sheet3.Cells(i, 5)
  17.     Ar(i, 5) = Sheet3.Cells(i, 6)
  18.   End If
  19. Next i
  20. Sheet1.Cells(2, 27).Resize(65534, 5) = Ar
  21. End Sub
複製代碼

作者: swtseng    時間: 2012-10-29 09:10

感謝各位大大的協助,我試了一下stillfish00 和GBKEE 的方法
小弟原本的程式碼執行約2秒,用了兩位大大的程式碼,0.多秒就可執行完成
小弟受教了

不過還是GBKEE的陣列速度最快




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