使用 vba 将大文本/csv 文件导入 excel

Question

我在 csv 文件中获取数据，我需要将数据导入 excel。我使用下面的 vba 代码来完成我的任务（经过相应修改后，我也是从某个站点获得的）：

---

Sub ImportTextFile()

Dim vFileName

On Error GoTo ErrorHandle

vFileName = Application.GetOpenFilename("CSV Files (*.csv),*.csv")

If vFileName = False Or Right(vFileName, 3) <> "csv" Then
   GoTo BeforeExit
End If

Application.ScreenUpdating = False

Workbooks.OpenText Filename:=vFileName, _
    Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, _
    ConsecutiveDelimiter:=False, Tab:=False, _
    Semicolon:=True, Comma:=False, Space:=False, _
    Other:=False, TrailingMinusNumbers:=True, _
    Local:=True

Columns("A:A").EntireColumn.AutoFit

BeforeExit:
Application.ScreenUpdating = True
Exit Sub
ErrorHandle:
MsgBox Err.Description
Resume BeforeExit
End Sub

---

到目前为止，此代码对我有所帮助，因为 csv/文本文件中的行/记录数少于 1,048,576（这是工作表中 excel 的行数限制）。现在 csv/文本文件中的记录数是限制的 10 倍。

我需要帮助

• 修改此代码，它会自动生成工作表（在同一工作簿中）并在每个工作表上放置 1000000 条记录，直到 text/csv 文件结束。

感谢您在这方面的帮助。谢谢

Answer 1

你可以试试下面的代码。您需要将 numOfLines 变量的值更改为 1046000 或任何您需要的值。 确保在 Excel 中打开脚本库：工具 > 参考：Microsoft Scripting Control 1.0 & Microsoft Scriplet Runtime

我在一个包含 80 行的 .csv 文件上测试了此代码，但我将 numOfLines 设置为 10，因此我最终得到了 8 个工作表，每个工作表仅包含来自 .csv 文件的 10 行。 如果您将 numOfLines 更改为 1000000，通过扩展，它应该为您提供适当数量的工作表，每个工作表都包含指定的行数限制。

希望这会有所帮助。

Sub textStreamToExcel()

'Add Scripting references in Tools before you write this code:
'Microsoft Scripting Control 1.0 and Microsoft Scripting Runtime

Dim numOfLines As Long
numOfLines = 10 '################### change this number to suit your needs

'Enter the source file name
Dim vFileName
vFileName = Application.GetOpenFilename("Text Files (*.txt),*.txt")

If vFileName = False Then
    Exit Sub
End If

Dim fso As FileSystemObject
Set fso = New FileSystemObject

Dim ts As TextStream
Dim line As String
Dim counter As Long

Set ts = fso.OpenTextFile(vFileName, ForReading)

Dim wkb As Workbook
Set wkb = Workbooks.Add
wkb.Activate
'Save your file, enter your file name if you wish
Dim vSavedFile
vSavedFile = wkb.Application.GetSaveAsFilename(FileFilter:="Excel Files (*.xls), *.xls")


If vSavedFile = False Then
    Exit Sub
End If

wkb.SaveAs vSavedFile

Dim cwks As Integer
cwks = wkb.Sheets.Count

Dim iwks As Integer
iwks = 1
Dim wkbS As Excel.Worksheet

Application.ScreenUpdating = False
Looping:
counter = 1
If iwks <= cwks Then
    Set wkbS = wkb.Worksheets(iwks)
    wkbS.Activate
    Range("A1").Activate

    While counter <= numOfLines

        If ts.AtEndOfStream <> True Then

            line = ts.ReadLine
            If ActiveCell.Value = "" Then
                ActiveCell.Value = CStr(line)
            End If
            ActiveCell.Offset(1, 0).Activate
            counter = counter + 1
        Else
            ts.Close
            GoTo Ending
        End If
    Wend
Else
    Set wkbS = wkb.Worksheets.Add(After:=Sheets(Sheets.Count))
    wkbS.Activate
    Range("A1").Activate

    While counter <= numOfLines

        If ts.AtEndOfStream <> True Then

            'If the last line has been read it will give you an Input error
            line = ts.ReadLine
            If ActiveCell.Value = "" Then
                ActiveCell.Value = CStr(line)
            End If
            ActiveCell.Offset(1, 0).Activate
            counter = counter + 1
        Else
            ts.Close
            GoTo Ending
        End If
    Wend
End If

iwks = iwks + 1

If ts.AtEndOfStream <> True Then
    GoTo Looping
Else
    GoTo Ending
End If

Ending:
Application.ScreenUpdating = True
Set fso = Nothing
Set ts = Nothing
Set wkb = Nothing
Set wkbS = Nothing
MsgBox "Transfer has been completed"
Exit Sub

ErrorHandler:

MsgBox "The following error has occured:" & Chr(13) & Chr(13) & "Error No: " & Err.Number * Chr(13) & "Description: " & Chr(13) & Err.Description

End Sub

Answer 2

为了将此文件导入 Excel，您需要将其拆分并将数据放置在多个工作表上。这不可能是您使用的直接导入方法。最好的办法是使用 ADO 将 CSV 文件读入 Recordset 对象，然后将 Recordset 输出到各个工作表，同时指定要输出的记录数。

总的来说，这将是一个相当缓慢的过程。你为什么要在 Excel 中显示这个？像 Access 这样的东西可能是一个更好的地方来存储数据（甚至将其保存在 CSV 中），然后从 Excel 连接到它以进行数据透视表和/或其他分析。