作者:
genow 2018-09-24 22:54:49軟體: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