- 帖子
- 471
- 主題
- 121
- 精華
- 0
- 積分
- 579
- 點名
- 0
- 作業系統
- WIN10
- 軟體版本
- OFFICE2019
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2015-4-16
- 最後登錄
- 2023-1-17
|
[發問] 如何優化-彙整多個工作表內的部份內容(陣列方式)
請問以下程式碼還能如何優化已及如何釋放記憶體呢
已經使用陣列方式抓取數據~但速度還是有點慢 約200個檔案
Sub 批次抓數據()
Application.Calculation = xlManual '手動計算,關閉
Application.ScreenUpdating = False ' 螢幕刷新,關閉
Dim filenames As Variant
''設置數組給變量和真為多選
' set the array to a variable and the True is for multi-select
filenames = Application.GetOpenFilename(, , , , True)
counter = 1
' 選擇總共要開啟的檔案
While counter <= UBound(filenames)
'打開選定的文件,且不更新連結
Workbooks.Open filenames(counter), UpdateLinks:=0
'巨集
抓數據
'關閉選擇的檔案
'ActiveWorkbook.Close True
' 消息框 顯示文件名
'MsgBox filenames(counter)
'開啟新檔案
counter = counter + 1
Wend
' 螢幕刷新,開啟
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub
-----------------------------------------
Sub 抓數據()
Dim strArr() As Variant
Dim I As Long, J As Long
Dim K As Long
workname = ThisWorkbook.Name
週數 = Sheets("工作表1").Range("AA2")
範圍1 = Sheets("工作表1").Range("AB2")
範圍2 = Sheets("工作表1").Range("AB3")
Sheets(週數).Select
strArr() = Range("S" & 範圍1 & ":AV" & 範圍2)
For J = 1 To 30
For I = 1 To 10
K = K + 1
strArr(I, J) = strArr(I, J) '& "(Change Index=" & K & ")"
Next I
Next J
ActiveWorkbook.Close True
Windows(workname).Activate
Rng = Cells(1, 1).End(xlDown).Row + 1 '第一格最末列+1
Sheets("工作表1").Range("A" & Rng).Resize(10, 30) = strArr()
End Sub |
|
發表於 2015-9-14 11:15
| 
