[算表] EXCEL VBA 同一个宏重复执行效率降低

楼主: 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
作者: newacc (XD)   2018-09-24 23:21:00
num值或许可以使用split方式来解析Cells(i,1)程式中会大量调用Cells内容,可以试试看一开始直接把工作表1的A1:A100值先存在一个array里面,之后循环里需要时再从array(i)叫值出来不过我会想先分段计时看看,才知道一直呼叫cells值是不是拖慢速度的原因另外,不确定Print会不会也是拉长速度的原因,可以试试看先全部存在一个变量里,循环跑完之后再写进txt档里我猜工作表2删100次也是一个主因,建议不要在循环中执行delete动作,可以跟工作表1一样套用i控制变量,最后再一次把工作表2.Range("1:100").Delete即可实测Print速度很快,存变量反而慢很多0rz呃,刚刚在看到你的QueryTable是放在工作表2的A1 QQ我有个疑问,请问你加载的外部资料内容有多少?除了K1的值以外,其他的值会用到吗?我自己测试,如果有新的资料进来,会把旧资料往右推,但因为你每个循环都会删掉第一行,所以越早进来的资料,会一行一行被删掉,如果只需要读K1值的话,一是看有没有办法不要用QueryTable,直接在档案中读取。二是把.RefreshStyle值改成xlOverwriteCells,也不需要把第一行删掉,新资料会自动把旧资料覆蓋掉当然这些还是跟你的资料内容有关
楼主: genow   2018-09-25 07:56:00
感谢回复,今天人在外面,等晚上回家时立即来试试,有问题再请教!

Links booklink

Contact Us: admin [ a t ] ucptt.com