Question

我正在阅读一个包含5000个字符串的文本文件。每个字符串包含Date + Time，然后包含3个值。日期和时间之间的分隔符是一个空格，然后三个值以制表符分隔。第一个字符串（strData（0））只是一个标题，所以我不需要它。最后一个字符串只是一个简单的＆＃34;结束＆＃34;。

以下代码有效，但导入工作表需要1分钟！我能做些什么来改善这一点，以及需要时间的是什么？屏幕更新已关闭。

   '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:

Answer 1

Excel可以处理多种类型的分隔符（制表符和空格），并从文本中获取数据。这就是我从宏录像机那里得到的东西

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中的字符串操作要快得多。

Answer 2

尝试这样的事情：

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中比使用工作表快得多的数组。

Answer 3

我认为问题是你可能正在二进制文件中读取文件。尝试以下方法。我运行了5100多条记录，并在一秒钟内解析了它。

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

VBA性能问题 - 迭代

3 个答案: