[發問] 如何優化-彙整多個工作表內的部份內容(陣列方式)

starry1314

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

准提部林

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

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

starry1314

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

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

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

PKKO

回復 3# starry1314


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

starry1314

回復 4# PKKO

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

准提部林

回復 3# starry1314


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

starry1314

回復 6# 准提部林

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