麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 如何優化-彙整多個工作表內的部份內容(陣列方式) [打印本頁]

作者: starry1314 時間: 2015-9-14 11:15 標題: 如何優化-彙整多個工作表內的部份內容(陣列方式)

請問以下程式碼還能如何優化已及如何釋放記憶體呢
已經使用陣列方式抓取數據~但速度還是有點慢約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 15:08

將寫入資料部份先槓掉，只測試各來源檔的OPEN及CLOSE，
即可比較所耗的時間在哪部份？

若是已關閉自動重算還是要很久，就要去優化每個來源檔，
或者上傳一個來源檔給大家參考看看～

作者: starry1314 時間: 2015-9-14 16:46

回復 2# 准提部林
問題應是源檔較大每個約400K左右,每個檔裡面皆有個資料庫定義了約1000個名稱(下拉清單使用)加上近一萬個函數
想請問如果將資料庫單獨讓他獨立出來成(資料庫.xlsm),每個檔案都去讀取資料庫內的定義名稱~會否造成運算更緩慢呢，因一年至少會產生約三千個檔案去讀取資料庫的定義名稱

版大~另想請問一下
Rng = Cells(1, 1).End(xlDown).Row + 1 '第一格最末列+1

如果A2無資料會跳至一百萬列,想請問如何客服這問題

作者: PKKO 時間: 2015-9-14 16:58

回復 3# starry1314

Cells(1040000, 1).End(xlUp).Row '找出104萬列的A欄位裡面,哪一個資料是最後一列,如果是舊版的2003可以把104萬改成65536

作者: starry1314 時間: 2015-9-14 17:05

回復 4# PKKO

感謝教學～原來還能這樣用!!

作者: 准提部林 時間: 2015-9-14 17:37

回復 3# starry1314

每個檔案都配置〔資料庫〕工作表，定義了約1000個名稱（下拉清單用），
若這工作表只是純文字無公式，它只讓檔案稍微變大，對開啟操作應還好，
獨立出來讓所有來源檔〔跨檔〕引用？可能外部連結更加麻煩！
　
來源檔的公式，建議在新增資料時，用VBA刷新一次再貼成〔值〕，
例如：今天在第２～１０００列新增資料，完成後，以VBA刷新這部份的公式值，
　　　明天在第１００１～３０００列新增資料，也只針對此部份刷新，
　　　這樣不僅在操作來源檔時不致有卡檔現像，要匯整時也較有效益！
　
取得最後一筆資料的下一空白位置，通常用：
R = Cells(Rows.Count, 1).End(xlUp) + 1
Rows.Count = 工作表的總列數

作者: starry1314 時間: 2015-9-16 10:09

回復 6# 准提部林

謝謝指導~我在嘗試調整看看

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