麻辣家族討論版版 » Excelㄧ般區 » 迴圈程式碼，請問是否有更快的執行方式??

返回列表下一主題上一主題發帖

[發問] 迴圈程式碼，請問是否有更快的執行方式??

小學生 Rank: 1

帖子: 16
主題: 5
精華: 0
積分: 27
點名: 0
作業系統: xp
軟體版本: office2003
閱讀權限: 10
性別: 男
註冊時間: 2012-10-3
最後登錄: 2012-10-29

1^# 跳轉到 » 倒序看帖

字體大小: tT

發表於 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

樓主熱帖

收藏

博士班 Rank: 6 Rank: 6

帖子: 2035
主題: 24
精華: 0
積分: 2031
點名: 0
作業系統: Win7
軟體版本: Office2010
閱讀權限: 100
性別: 男
註冊時間: 2012-3-22
最後登錄: 2024-2-1

2^#

發表於 2012-10-26 14:59 | 只看該作者

回復 1# swtseng

For i = 2 To Sheet1.Cells(2, 27).End(xlDown).Row
.............
Next i

複製代碼

　暱稱: 隨風飄蕩的羽毛
　頭銜: [御用]潛水艇

高中生 Rank: 3 Rank: 3

帖子: 852
主題: 79
精華: 0
積分: 918
點名: 0
作業系統: Windows 7 , XP
軟體版本: Office 2007, Office 2003,Office 2010,YoZo Office
閱讀權限: 50
性別: 男
來自: 宇宙
註冊時間: 2011-4-8
最後登錄: 2024-2-21

3^#

發表於 2012-10-26 16:45 | 只看該作者

本帖最後由 mark15jill 於 2012-10-26 16:46 編輯

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

'簡易判斷
kk = 工作表2.Range("c1").CurrentRegion.Rows.Count
For sj = 1 To kk
For uu = 8 To 11
工作表1.Cells(sj, uu) = 工作表2.Cells(sj, uu - 5)
Next
Next

複製代碼

sj =判斷行數
uu=從 N 到 K 欄 ( 在此以 8~11欄為例)

  多做多想多學習，少看少錯少迷途

  多做=多多練習，多多編寫。
  多想=想想為什麼人家程式要那樣寫，如果換成自己，又會怎寫。
  多學習=學習人家的發問並解答，學習人家的寫法

  少看=只看不做也枉然

大學生 Rank: 4

帖子: 1018
主題: 15
精華: 0
積分: 1058
點名: 0
作業系統: win7 32bit
軟體版本: Office 2016 64-bit
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2012-5-9
最後登錄: 2022-9-28

4^#

發表於 2012-10-26 17:19 | 只看該作者

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

先copy到同一個sheet再做比較 , 試看看:

Sub test()
Application.ScreenUpdating = False
Dim my_min%, my_max%
my_min = 30
my_max = 50
sheet1.Range("AA:AA") = sheet3.Range("A:A").Value
sheet1.Range("AB:AE") = sheet3.Range("C:F").Value
sheet1.Cells(27) = "Num"
sheet1.Cells(28) = "x(1)"
sheet1.Cells(29) = "y(2)"
sheet1.Cells(30) = "iv(3)"
sheet1.Cells(31) = "vf(4)"
Dim n As Range
For Each n In sheet1.Range("AE2:AE65535")
If n.Value > my_min And n.Value < my_max Then
Else
n.Offset(, -3).Resize(, 4).ClearContents
End If
Next n
Application.ScreenUpdating = True
End Sub

複製代碼

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

5^#

發表於 2012-10-26 17:27 | 只看該作者

回復 1# swtseng
試試看

Option Explicit
Sub xx()
Dim my_min%, my_max%, i&, Ar(2 To 65535, 1 To 5)
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
Ar(i, 1) = Sheet3.Cells(i, 1)
If Sheet3.Cells(i, 6) > my_min And Sheet3.Cells(i, 6) < my_max Then
Ar(i, 2) = Sheet3.Cells(i, 3)
Ar(i, 3) = Sheet3.Cells(i, 4)
Ar(i, 4) = Sheet3.Cells(i, 5)
Ar(i, 5) = Sheet3.Cells(i, 6)
End If
Next i
Sheet1.Cells(2, 27).Resize(65534, 5) = Ar
End Sub

複製代碼

小學生 Rank: 1

帖子: 16
主題: 5
精華: 0
積分: 27
點名: 0
作業系統: xp
軟體版本: office2003
閱讀權限: 10
性別: 男
註冊時間: 2012-10-3
最後登錄: 2012-10-29

6^#

發表於 2012-10-29 09:10 | 只看該作者

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

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

靜思自在 : 【時間成就一切】時間可以造就人格，可以成就事業，也可以儲積功德。

返回列表下一主題上一主題