VBA性能问题 – 迭代

我正在阅读5000个string的文本文件。 每个string都包含Date + Time和3个值。 date和时间之间的分隔符是空格,然后这三个值是制表符分隔的。 第一个string(strData(0))只是一个头,所以我不需要这个。 最后一个string只是一个简单的“结束”。

下面的代码工作,但需要1分钟导入到工作表! 我能做些什么来改善这一点,什么是需要时间?
屏幕更新已closures。

'open the file and read the contents Open strPpName For Binary As #1 MyData = Space$(LOF(1)) Get #1, , MyData Close #1 strData() = Split(MyData, vbCrLf) 'split the data and write into the correct columns Row = 3 i = 0 For Each wrd In strData() If i > 0 Then 'first string is only header tmpData() = Split(wrd, vbTab) DateString() = Split(tmpData(0), " ") If DateString(0) <> "End" Then ActiveSheet.Cells(Row, 5) = DateString(0) 'Date ActiveSheet.Cells(Row, 6) = DateString(1) 'Time ActiveSheet.Cells(Row, 2) = tmpData(1) 'Value1 ActiveSheet.Cells(Row, 3) = tmpData(2) 'Value2 ActiveSheet.Cells(Row, 4) = tmpData(3) 'Value3 Row = Row + 1 Else GoTo Done End If End If i = i + 1 Next wrd Done: 

试试这样的事情:

 Dim Values(), N, I N = 100 ReDim Values(6, N) ... Do While Not EOF(1) I = I + 1 If I > N Then N = N + 100 ReDim Preserve Values(6, N) End If Values(0, I) = ... ... Loop Range("A1:F" & i) = Values 

该循环将与VBA中的数组一起工作比使用该表快得多。

Excel可以处理多种types的分隔符(制表符和空格),从文本中获取数据。 这是我从macroslogging器

 Sub Macro1() ' ' Macro1 Macro ' ' With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;C:\Users\jeanno\Documents\random.txt", Destination:=Range("$A$1")) .CommandType = 0 .Name = "random_1" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 437 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = True .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = True .TextFileColumnDataTypes = Array(1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With End Sub 

这将比VBA中的string操作快得多。

我认为问题是你可能正在读取二进制文件。 尝试以下方法。 我跑了5100多条logging,并在一秒钟内parsing了它。

 Public Sub ReadFileToExcel(filePath As String, rowNum As Long) '****************************************************************************** ' Opens a large TXT File, reads the data until EOF on the Source, ' adds the data in a EXCEL File, based on the row number. ' Arguments: ' `````````` ' 1. The Source File Path - "C:\Users\SO\FileName.Txt" (or) D:\Data.txt ' 2. The Row number you wish to start adding data. '******************************************************************************* Dim strIn As String, lineCtr As Long Dim tmpData, DateString 'Open the SOURCE file for Read. Open filePath For Input As #1 'Loop the SOURCE till the last line. Do While Not EOF(1) 'Read one line at a time. Line Input #1, strIn lineCtr = lineCtr + 1 If lineCtr <> 1 Then If InStr(strIn, "END") = 0 Then tmpData = Split(strIn, vbTab) DateString = Split(tmpData(0), " ") ActiveSheet.Cells(rowNum, 5) = DateString(0) 'Date ActiveSheet.Cells(rowNum, 6) = DateString(1) 'Time ActiveSheet.Cells(rowNum, 2) = tmpData(1) 'Value1 ActiveSheet.Cells(rowNum, 3) = tmpData(2) 'Value2 ActiveSheet.Cells(rowNum, 4) = tmpData(3) 'Value3 rowNum = rowNum + 1 End If End If Loop Debug.Print "Total number of records - " & lineCtr 'Print the last line 'Close the files. Close #1 End Sub