VBA将大量数据从文本文件加载到Excel

Question

I have a problem loading data to Excel from a text file. The text file has about 230,000 lines and each line has exactly 130 characters. My goal is to get, from each line, specific data for what I'm trying to load the file into Excel and then retrieve the data I need.

First, I used the following code, but it takes about 7 minutes.

Sub leerTXT()
Dim strArchivo As String 'ruta del archivo
Dim intResultado As Integer 'resultado del dialogo


'---------- RUTA DEL ARCHIVO ----------
'Abrir dialog y preparar
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
intResultado = Application.FileDialog(msoFileDialogOpen).Show

'sólo si hay resultado positivo abrir fichero y leer
If intResultado <> 0 Then
    strArchivo = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
    On Error GoTo lblError:

Dim strFila As String 'filas que se van a leer
Dim iFila As Long  'numero de fila en la que se esta en el fichero
Dim jFila As Long 'numero de fila en el excel
'posicionarse en la fila 1
iFila = 1
jFila = 1

    'abrir el archivo
    Open strArchivo For Input As #1
    'loop mientras no se ha llegado al final del archivo
    Do Until EOF(1)

        If iFila Mod 70 > 17 Then
            'leer la fila actual
            Line Input #1, strFila

            'leer la linea y copiar a celda
            Cells(jFila, 1) = strFila

            jFila = jFila + 1
        End If

        'incrementar iFila en uno y pasar a la siguiente fila
        iFila = iFila + 1

    'loopear mientras condicion
    Loop

End If

'cerrar el archivo
Close #1

lblError:
If Err.Number <> 0 Then
MsgBox (Err.Number)
MsgBox (Err.Description)
Err.Clear
'cerrar el archivo
Close #1
End If

End Sub

But as I said, that takes too long, so I searched for other ways and I saw something like the following:

Dim FSO As Object, MyFile As Object
Dim FileName As String, Arr As Variant
Dim f As Long

FileName = textfilename
Set FSO = CreateObject("Scripting.FileSystemObject")
Set MyFile = FSO.OpenTextFile(FileName, 1)
Arr = Split(MyFile.ReadAll, vbNewLine) ' Arr is zero-based array

Dim BigGuy(0 To UBound(Arr, 1), 1 To 1) As Long

Dim I As Long
For I = 0 To UBound(Arr)
    BigGuy(I, 1) = I
Next
'For test
'Fill column A from this Array Arr
   'UBound(Arr) + 1 Application.Transpose(
Range("A1:A500") = BigGuy

The clue is to use array and paste range at it seems to be faster, but as the file is too long to transpose, I need to transpose it manually, but UBound(Arr) doesn't work and I don't know how to import the data.

And by the way, is there any way of just retrieving specific characters from the file (in an exact position), as every line has exactly the same length?

Answer 1

Something like:

Dim BigGuy()
Dim numLines As Long
Arr = Split(MyFile.ReadAll, vbNewLine) ' Arr is zero-based array

numLines = UBound(Arr) + 1

ReDim BigGuy(1 To numLines, 1 To 1)


Dim I As Long
For I = 0 To numLines-1
    BigGuy(I+1, 1) = Arr(I)
Next

Range("A1").Resize(numLines, 1) = BigGuy

Answer 2

The array size is limited to 65 536 elements (Integer is 16-bit number). In fact only to 32767 because it is signed number.

You can combine first method with second approach reading file in chunks of 32767 elements and fill them by array.

Something like this:

Option Explicit
Public Sub test()
Dim strFila As String
Dim i As Integer, j As Long
Dim rng As String

    Dim BigGuy(1 To 32767, 1 To 1)
    i = 1
    j = 1
    Open "c:\temp\data.txt" For Input As #1
    Do Until EOF(1)
        Line Input #1, strFila
        BigGuy(i, 1) = strFila
        i = i + 1
        If i = 32767 Then
            rng = "A" & j & ":A" & j + i - 1
            Range(rng) = BigGuy
            j = j + 32766
            i = 1
        End If
    Loop

    If i > 1 Then
        rng = "A" & j & ":A" & j + i - 2
        Range(rng) = BigGuy
    End If
    Close #1

End Sub

Performance - around 3 sec on my station.

To extract part of text on well known position use mid$()