VBA импортирует и разбивает текстовый файл с разделителями

Question

У меня есть файлы с разделителями табуляции, которые необходимо импортировать, а затем только определенная информация извлекается и вставляется в мою рабочую книгу.Я написал следующий Sub, и он работает, но это медленно.Я должен представить, что это из-за цикла for, но я довольно новичок в этом, и это лучшее, что я мог придумать.Я вижу, что EOF используется, но могу ли я использовать его после разделения?

Sub FindResults()
'Selecting file for import'
        Dim FileSelect As Object
            Dim PlateMapFolder As String
                PlateMapFolder = "C:\"
        Set FileSelect = Application.FileDialog(msoFileDialogFilePicker)

                With FileSelect
                    .InitialFileName = PlateMapFolder
                    .AllowMultiSelect = False
                    .Title = "Please select associated run"
                    .Show

                        If .SelectedItems.Count = 0 Then
                        Exit Sub
                        End If

                    SelectedFile = Dir(.SelectedItems(1))
                End With

Application.ScreenUpdating = False
Application.DisplayAlerts = False

'Splitting SelectedFile
Const strSearch = "[Results]"
Dim intFileNumber As Integer

intFileNumber = FreeFile

Open SelectedFile For Input As intFileNumber
    strFileContent = Input(LOF(intFileNumber), intFileNumber)

    'Split result file at [Results]
    strResults = Split(strFileContent, strSearch)

    'Split line breaks
    arrResultsLine = Split(strResults(1), vbLf)

   'Split each line by tab
   intRow = 1
    For i = 2 To UBound(arrResultsLine) - 1
        arrResultsTab = Split(arrResultsLine(i), vbTab)
                Sheets("RawData").Range("A" & CStr(intRow)).Value = arrResultsTab(0)
                Sheets("RawData").Range("B" & CStr(intRow)).Value = arrResultsTab(1)
                Sheets("RawData").Range("C" & CStr(intRow)).Value = arrResultsTab(2)
                Sheets("RawData").Range("D" & CStr(intRow)).Value = arrResultsTab(3)
                Sheets("RawData").Range("E" & CStr(intRow)).Value = arrResultsTab(4)
            intRow = intRow + 1
        Next i

End Sub

Answer 1

Наилучшей скорости можно достичь, собрав все данные в массив и записав все это на лист за один раз.

В вашем коде также есть масса других проблем, см. Примечания нижеотмечены <~~~

Sub FindResults()
    'Selecting file for import
    Dim FileSelect As FileDialog '<~~~ use explicit type
    Dim PlateMapFolder As String

    '<~~~ declare all Variables
    Dim SelectedFile As String
    Dim strFileContent As String
    Dim strResults() As String
    Dim arrResultsLine() As String
    Dim arrResultsTab() As String
    Dim i As Long

    PlateMapFolder = "C:\"
    Set FileSelect = Application.FileDialog(msoFileDialogFilePicker)
    With FileSelect
        .InitialFileName = PlateMapFolder
        .AllowMultiSelect = False
        .Title = "Please select associated run"
        .Show

        If .SelectedItems.Count = 0 Then
            Exit Sub
        End If

        'SelectedFile = Dir(.SelectedItems(1)) '<~~~ No need for Dir here
        SelectedFile = .SelectedItems(1)
    End With

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    'Splitting SelectedFile
    Const strSearch = "[Results]"
    Dim intFileNumber As Integer

    intFileNumber = FreeFile

    Open SelectedFile For Input As intFileNumber
    strFileContent = Input(LOF(intFileNumber), intFileNumber)
    Close intFileNumber '<~~~ close file after use

    'Split result file at [Results]
    strResults = Split(strFileContent, strSearch)

    'Split line breaks
    arrResultsLine = Split(strResults(1), vbLf)

    'Split each line by tab

    ' <~~~ declare and size array to hold results
    Dim Res As Variant
    ReDim Res(1 To UBound(arrResultsLine) - 2, 1 To 5)
    'intRow = 1 <~~~ not needed

    '<~~~ this will skip first and last line after [Results].
    '     Is this what you want?
    '     If not, also adjust Redim size
    For i = 2 To UBound(arrResultsLine) - 1
        arrResultsTab = Split(arrResultsLine(i), vbTab)
        '<~~~ collect data into array
        Res(i - 1, 1) = arrResultsTab(0)
        Res(i - 1, 2) = arrResultsTab(1)
        Res(i - 1, 3) = arrResultsTab(2)
        Res(i - 1, 4) = arrResultsTab(3)
        Res(i - 1, 5) = arrResultsTab(4)
    Next i
    '<~~~ write to sheet in one go
    Sheets("RawData").Range("A1").Resize(UBound(Res, 1), UBound(Res, 2)).Value = Res

    '<~~~ turn these back on!
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Answer 2

Запись ячейка за ячейкой довольно медленная, поэтому это будет быстрее.

For i = 2 To UBound(arrResultsLine) - 1

     arr = Split(arrResultsLine(i), vbTab)

     'write the data as an array
     Sheets("RawData").Cells(intRow, "A").Resize(1, 5).Value = _
           Array(arr(0), arr(1), arr(2), arr(3), arr(4))

     intRow = intRow + 1

Next i

Если вам нужна большая скорость, создайте двумерный массив со всеми данными, а затем запишите его непосредственно на лист за одну операцию.