Question

我在从文本文件中将数据加载到Excel时遇到问题。文本文件大约有230,000行，每行有130个字符。我的目标是从每一行获取特定数据，以便我尝试将文件加载到Excel中，然后检索我需要的数据。

首先，我使用了以下代码，但大约需要7分钟。

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

但正如我所说，这需要太长时间，所以我寻找其他方法，我看到如下内容：

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

线索是使用数组和粘贴范围似乎更快，但由于文件太长而无法转置，我需要手动转置，但UBound(Arr)不起作用我不知道如何导入数据。

顺便说一下，有没有办法只从文件中检索特定字符（在一个确切的位置），因为每一行都有完全相同的长度？

Answer 1

类似的东西：

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

数组大小限制为65 536个元素（整数为16位数）。实际上只有32767因为它是签名号码。

您可以将第一种方法与第二种方法读取文件组合成32767个元素的块，然后按数组填充。

这样的事情：

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

性能 - 我的电台约3秒钟。

要使用mid$()

提取众所周知位置的部分文字

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

2 个答案: