Ошибка индекса вне диапазона при записи массива из текстового файла в электронную таблицу

У меня есть функция в электронной таблице Excel, которая извлекает данные из txt-файла фиксированной ширины и вставляет их в электронную таблицу. В настоящее время функция сохраняет каждый набор данных в массиве и вставляет его построчно. Однако я приближаюсь к моменту, когда текстовый файл содержит 90 000 строк, а время обработки макроса увеличивается. Я пытался оптимизировать макрос так, чтобы вместо того, чтобы идти построчно, он сохранял все данные в массив и вставлял их все сразу, чтобы уменьшить количество вызовов макроса на лист. Вот исходный код:

Function ImportFixedWidth(FileName As String, _
        StartCell As Range, _
        IgnoreBlankLines As Boolean, _
        SkipLinesBeginningWith As String, _
                SkipLinesBeginningWith2 As String, _
        ByVal FieldSpecs As String) As Long

    Dim FINdx As Long
    Dim c As Long
    Dim r As Range
    Dim FNum As Integer
    Dim s As String
    Dim RecCount As Long
    Dim FieldInfos() As String
    Dim FInfo() As String
    Dim N As Long
    Dim T As String
    Dim B As Boolean
    Dim InfoParts As Variant
    Dim rowData As Variant

    Application.EnableCancelKey = xlInterrupt
    On Error GoTo EndOfFunction:

    If Dir(FileName, vbNormal) = vbNullString Then
        ' file not found
        ImportFixedWidth = -1
        Exit Function
    End If
    
    If Len(FieldSpecs) < 3 Then
        ' invalid FieldSpecs
        ImportFixedWidth = -1
        Exit Function
    End If
        
    If StartCell Is Nothing Then
        ImportFixedWidth = -1
        Exit Function
    End If
       
    Set r = StartCell(1, 1)
    c = r.Column
    FNum = FreeFile
  
    FieldInfos = Split(FieldSpecs, "|")
    
    Open FileName For Input Access Read As #FNum

    If StrComp(Right(FieldSpecs, 1), "|", vbBinaryCompare) = 0 Then
        FieldSpecs = Left(FieldSpecs, Len(FieldSpecs) - 1)
    End If
    
    Do
        ' read the file
        Line Input #FNum, s
        If (SkipLinesBeginningWith <> vbNullString And StrComp(Left(Trim(s), Len(SkipLinesBeginningWith)), SkipLinesBeginningWith, vbTextCompare) And SkipLinesBeginningWith2 <> vbNullString And StrComp(Left(Trim(s), Len(SkipLinesBeginningWith2)), SkipLinesBeginningWith2, vbTextCompare)) Then
            If Len(s) = 0 Then
                If IgnoreBlankLines = False Then
                    Set r = r(2, 1)
                Else
                    ' do nothing
                End If
            Else
              
    
                If FieldSpecs = vbNullString Then
                  
                Else
                
                    If ImportThisLine(s) = True Then
                        FINdx = LBound(FieldInfos)
                        ReDim rowData(1 To UBound(FieldInfos) + 1)
                        c = r.Column
                    
                  Do While FINdx <= UBound(FieldInfos)
                InfoParts = Split(FieldInfos(FINdx), ",")
            rowData(FINdx - LBound(FieldInfos) + 1) = Mid(s, CLng(InfoParts(0)), CLng(InfoParts(1)))
              
        FINdx = FINdx + 1
    Loop
    r.Offset(RecCount, 0).Resize(1, UBound(rowData)).Value = rowData
      

                    End If
                    Set r = r(2, 1)
                End If
            End If
        Else
            ' no skip first char
        End If
        
    Loop Until EOF(FNum)
    
EndOfFunction:
    If Err.Number = 0 Then
        ImportFixedWidth = RecCount
    Else
        ImportFixedWidth = -1
    End If
    Close #FNum
    
End Function

Я попытался обновить код следующим образом, чтобы попытаться оптимизировать производительность:

Function ImportFixedWidth(FileName As String, _
                          StartCell As Range, _
                          IgnoreBlankLines As Boolean, _
                          SkipLinesBeginningWith As String, _
                          SkipLinesBeginningWith2 As String, _
                          ByVal FieldSpecs As String) As Long
    Dim FINdx As Long
    Dim c As Long
    Dim r As Range
    Dim FNum As Integer
    Dim s As String
    Dim RecCount As Long
    Dim FieldInfos() As String
    Dim InfoParts As Variant
    Dim rowData As Variant
    Dim allData() As Variant
    Dim numRows As Long
    
    Application.EnableCancelKey = xlInterrupt
    On Error GoTo EndOfFunction:
    
    If Dir(FileName, vbNormal) = vbNullString Then
        ' file not found
        ImportFixedWidth = -1
        Exit Function
    End If
    
    If Len(FieldSpecs) < 3 Then
        ' invalid FieldSpecs
        ImportFixedWidth = -1
        Exit Function
    End If
    
    If StartCell Is Nothing Then
        ImportFixedWidth = -1
        Exit Function
    End If
    
    Set r = StartCell(1, 1)
    c = r.Column
    FNum = FreeFile
    
    FieldInfos = Split(FieldSpecs, "|")
    
    Open FileName For Input Access Read As #FNum
    
    If StrComp(Right(FieldSpecs, 1), "|", vbBinaryCompare) = 0 Then
        FieldSpecs = Left(FieldSpecs, Len(FieldSpecs) - 1)
    End If
    
    Do
        ' read the file
        Line Input #FNum, s
        If (SkipLinesBeginningWith <> vbNullString And StrComp(Left(Trim(s), Len(SkipLinesBeginningWith)), SkipLinesBeginningWith, vbTextCompare)) And (SkipLinesBeginningWith2 <> vbNullString And StrComp(Left(Trim(s), Len(SkipLinesBeginningWith2)), SkipLinesBeginningWith2, vbTextCompare)) Then
            If Len(s) = 0 Then
                If IgnoreBlankLines = False Then
                    Set r = r(2, 1)
                Else
                    ' do nothing
                End If
            Else
                If FieldSpecs = vbNullString Then
                Else
                    If ImportThisLine(s) = True Then
                        FINdx = LBound(FieldInfos)
                        ReDim rowData(1 To UBound(FieldInfos) + 1)
                        c = r.Column
                        
                        Do While FINdx <= UBound(FieldInfos)
                            InfoParts = Split(FieldInfos(FINdx), ",")
                            rowData(FINdx - LBound(FieldInfos) + 1) = Mid(s, CLng(InfoParts(0)), CLng(InfoParts(1)))
                            FINdx = FINdx + 1
                        Loop
                        RecCount = RecCount + 1
                        ReDim Preserve allData(1 To RecCount)
                        allData(RecCount) = rowData
                    End If
                    Set r = r(2, 1)
                End If
            End If
        Else
            ' no skip first char
        End If
    Loop Until EOF(FNum)
    
    If RecCount > 0 Then
        numRows = UBound(allData, 1)
        StartCell.Resize(numRows, UBound(allData, 2)).Value = allData
    End If
    
EndOfFunction:
    If Err.Number = 0 Then
        ImportFixedWidth = RecCount
    Else
        ImportFixedWidth = -1
    End If
    Close #FNum
End Function

Однако я постоянно получаю ошибку «Индекс вне диапазона» в следующей строке кода:

    If RecCount > 0 Then
        numRows = UBound(allData, 1)
        StartCell.Resize(numRows, UBound(allData, 2)).Value = allData
    End If

Я наблюдаю за кодом, и массив заполняется, как и ожидалось, данными из txt-файла. Я уверен, что есть простое решение, но есть ли что-то, чего мне не хватает, что могло бы устранить ошибку «Индекс вне диапазона»? Огромное спасибо за помощь!