[發問] 請教改良速度方法

stillfish00

回復 19# 198188
可以自己改阿 , 我是以為你要一直新增才這樣寫的..
    'nextRow = Sheets("Result").UsedRange.Rows.Count + 1
    nextRow = 2
    Sheets("Result").UsedRange.Offset(1).Clear
    ---略---
    'endRow = Sheets("Result").UsedRange.Rows.Count
    endRow = Sheets("Result").Range("A" & Sheets("Result").Rows.Count).End(xlUp)

198188

Sub Worksheet()
Dim LastRec As Integer
Dim i As Integer

Worksheets("Oracle").Range("G1").Select
ActiveCell.End(xlDown).Select
     LastRec = ActiveCell.Row
     
For i = 2 To LastRec
Worksheets("Oracle").Range("A" & i).Value = Worksheets("Oracle").Range("G" & i).Value '將G欄的值COPY到A欄

If IsError(Application.VLookup(Worksheets("Oracle").Range("C" & i).Value, Sheets("Follower").Range("A:E"), 5, False)) Then
Worksheets("Oracle").Range("B" & i).Value = ""  假如SHEET ORACLE C欄的值在SHEET FOLOWER A：E欄找不到，就將B欄設定空格
Else
Worksheets("Oracle").Range("B" & i).Value = Application.VLookup(Worksheets("Oracle").Range("c" & i).Value, Sheets("Follower").Range("A:E"), 5, False) 否則將SHEET ORACLE C欄在SHEET FOLLOWER尋找相同，並將相同的E欄值放在SHEET ORACLE B欄
End If

Next i
i = i + 1

End Sub

運行大約7000ROW,但運行得很慢，請問各位大大，有沒有可以加快運行的方法？

GBKEE

回復 22# 198188
測試完成約12秒,時間不算長吧!

1. Option Explicit
   
2. Sub Worksheet()
   
3.     Dim LastRec As Integer
   
4.     Dim i As Integer, T
   
5.     T = Time
   
6.     With Worksheets("Oracle")
   
7.          LastRec = .Range("G1").End(xlDown).Row
   
8.         .Range("A2:A" & LastRec).Value = .Range("G2:G" & LastRec).Value  '全部直接給值會快些
   
9.         For i = 2 To LastRec
   
10.             If IsError(Application.VLookup(Worksheets("Oracle").Range("C" & i).Value, Sheets("Follower").Range("A:E"), 5, False)) Then
    
11.                 .Range("B" & i).Value = ""
    
12.             Else
    
13.                 .Range("B" & i).Value = Application.VLookup(Worksheets("Oracle").Range("c" & i).Value, Sheets("Follower").Range("A:E"), 5, False)
    
14.             End If
    
15.         Next
    
16.     End With
    
17.     MsgBox Format(Time - T, "HH:MM:SS")
    
18. End Sub

複製代碼

198188

回復 23# GBKEE

12秒夠快了，謝謝~
另外請問如果用Option Explicit，我將資料從另外一個excel copy過來，它會自動run嗎？還是需要另外按鈕才能run?

GBKEE

回復 24# 198188
Option Explicit 陳述式 在模組層次中強迫每個在模組裏的變數都必須明確的宣告。
模組層有Option Explicit作用是:  系統會提醒,沒宣告的變數須宣告. 要養成這習慣 有助程式的偵錯.

198188

回復 25# GBKEE


    感謝解釋~
請問如果要copy過去後，不按鈕就自動run 可以嗎？

GBKEE

回復 26# 198188
你要在何種狀態下不按鈕就自動run
1.檔案開啟時
A: 在ThisWorkbook這模組中有一預設的程序

1. Private Sub Workbook_Open()
   
2.    '這裡的程式碼不按鈕就自動run
   
3. End Sub

複製代碼

B: 在VBA 的一般模組 寫上

1. Sub AUTO_OPEN()  
   
2. '這裡的程式碼不按鈕就自動run
   
3. End Sub

複製代碼

2.檔案開啟後選定(移動)到這工作表,在這工作表模組中有一預設的程序

1. Private Sub Worksheet_Activate()
   
2.    '這裡的程式碼不按鈕就自動run
   
3. End Sub

複製代碼

3.使用 OnTime 方法

1. Sub AUTO_OPEN()  
   
2. Application.OnTime Now + TimeValue("00:05:00"), "模組.程式名稱"
   
3. End Sub

複製代碼

198188

就是當該資料庫的資料有變動是run

198188

回復 27# GBKEE


   在18的發言
請問顯示今日或之後的日期，應該如何填？
>=today()   ?
>=5/12/2012 ?

GBKEE

回復 29# 198188
18# 附檔 [Rule] 工作表  Ordered Date 欄位的進階篩選公式
=">="&DATEVALUE("2012/10/1")    指定日期
=">="&TODAY()                                    當日