[算表] EXCEL VBA 同一個巨集重複執行效率降低

[genow ()]

軟體:EXCLE

版本:2010

您好

我運用EXCEL VBA撰寫一個巨集指令
內容是讀取100個JSON檔案後再將其內容重行排版後
輸出成1個TXT檔(目的是為了格式轉換)

但是我發現開啟這個EXCEL並第1次執行時耗時6.8秒
在未關閉EXCEL檔案情況下，執行第2次時耗時7.7秒
依此類推，第3次耗時8.9秒、第4次耗時10.64秒、第5次耗時13.56秒...

請問原因是什麼呢?因為我原始資料有達數十萬筆，如果依照這樣的速率
將無法繼續執行下去

感謝回復

巨集內容如下:

Sub test()
Dim Time0#
Time0 = Timer

Dim OutputFilePath As String
OutputFilePath = "D:\output.txt"
Open OutputFilePath For Output As #1

len1 = WorksheetFunction.CountA(Range("'工作表1'!A:A"))
For i = 1 To 100

    On Error Resume Next

    num1 = WorksheetFunction.Find(",", 工作表1.Cells(i, 1))
    numA = Mid(工作表1.Cells(i, 1), 1, num1 - 2)
    numB = Mid(工作表1.Cells(i, 1), num1 - 1, 1)

    num2 = WorksheetFunction.Find(",", 工作表1.Cells(i, 1), num1 + 1)
    numC = Mid(工作表1.Cells(i, 1), num1 + 1, num2 - num1 - 1)

    num3 = WorksheetFunction.Find(",", 工作表1.Cells(i, 1), num2 + 1)
    numD = Mid(工作表1.Cells(i, 1), num2 + 1, num3 - num2 - 1)

    num4 = WorksheetFunction.Find(",", 工作表1.Cells(i, 1), num3 + 1)
    numE = Mid(工作表1.Cells(i, 1), num3 + 1, num4 - num3 - 1)

    numF = Mid(工作表1.Cells(i, 1), num4 + 1, 8)

    Sheets("工作表2").Select
    filepath1 = "TEXT;D:\ " & 工作表1.Cells(i, 1)
    With ActiveSheet.QueryTables.Add(Connection:= _
        filepath1, Destination _
        :=Range("$A" & 1))
        .Name = 工作表1.Cells(i, 1)
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 65001
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

    num5 = Len(工作表2.Cells(1, 11))
    numG = Mid(工作表2.Cells(1, 11), 9, num5 - 9)
    工作表2.Rows("1:1").Select
    Selection.Delete Shift:=xlToLeft

    Print #1, 工作表1.Cells(i, 1); " "; numA; " "; numB; " "; numC; " ";
numD; " "; numE; " "; numF; " "; numG


Next
Close #1
MsgBox "執行時間 " & Timer - Time0 & " 秒" & vbCrLf & "平均時間" & (Timer -
Time0) / 100 & "秒"
End Sub


--
※ 發信站: 批踢踢實業坊(ptt.cc), 來自: 111.249.38.71
※ 文章網址: https://www.ptt.cc/bbs/Office/M.1537800892.A.93A.html
※ 編輯: genow (111.249.38.71), 09/24/2018 23:09:18
※ 編輯: genow (111.249.38.71), 09/24/2018 23:10:15
→ newacc: num值或許可以使用split方式來解析Cells(i,1)
→ newacc: 程式中會大量調用Cells內容，可以試試看一開始直接把工作
→ newacc: 表1的A1:A100值先存在一個array裡面，之後迴圈裡需要時再
→ newacc: 從array(i)叫值出來
→ newacc: 不過我會想先分段計時看看，才知道一直呼叫cells值是不是
→ newacc: 拖慢速度的原因
→ newacc: 另外，不確定Print會不會也是拉長速度的原因，可以試試看
→ newacc: 先全部存在一個變數裡，迴圈跑完之後再寫進txt檔裡
→ newacc: 我猜工作表2刪100次也是一個主因，建議不要在迴圈中執行
→ newacc: delete動作，可以跟工作表1一樣套用i控制變數，最後再一次
→ newacc: 把工作表2.Range("1:100").Delete即可
推 newacc: 實測Print速度很快，存變數反而慢很多0rz
→ newacc: 呃，剛剛在看到你的QueryTable是放在工作表2的A1 QQ
→ newacc: 我有個疑問，請問你載入的外部資料內容有多少？除了K1的值
→ newacc: 以外，其他的值會用到嗎？
→ newacc: 我自己測試，如果有新的資料進來，會把舊資料往右推，但因
→ newacc: 為你每個迴圈都會刪掉第一行，所以越早進來的資料，會一行
→ newacc: 一行被刪掉，如果只需要讀K1值的話，一是看有沒有辦法不要
→ newacc: 用QueryTable，直接在檔案中讀取。二是把.RefreshStyle值
→ newacc: 改成xlOverwriteCells，也不需要把第一行刪掉，新資料會自
→ newacc: 動把舊資料覆蓋掉
→ newacc: 當然這些還是跟你的資料內容有關
→ genow: 感謝回覆，今天人在外面，等晚上回家時立即來試試，有問題
→ genow: 再請教！