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

Importing big text/csv file into excel using vba

提问by Excl Learner

I get the data in csv file and I need to import the data into excel. I use the below vba code to complete my task (which I also got from some site after modified accordingly):

我在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

---

---

Till now, this code was helping me as the number of rows/records in csv/text file were less than 1,048,576 (which is row limit of excel in a sheet). Now number of records in the csv/text file are 10 times more than the limit.

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

I need help to

我需要帮助

• Modify this code, which automatically produces sheets (in the same workbook) and put 1000000 records on each sheet until text/csv file ends.

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

I appreciate your help on this. thanks

我很感激你在这方面的帮助。谢谢

回答by djevulen

You can try the below code. You need to change the value of numOfLines variable to 1046000 or whatever you need. Make sure that the Scripting library is switched on in your Excel: Tools > References: Microsoft Scripting Control 1.0 & Microsoft Scriplet Runtime

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

I tested this code on a .csv file with 80 lines, but I set numOfLines to 10, so I ended up with 8 worksheets each containing just 10 rows from the .csv file. If you change the numOfLines to 1000000, by extension, it should give you appropriate number of worksheets each containing the specified limit of rows.

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

Hope this helps.

希望这可以帮助。

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

回答by godlearner

In order to to import this file into Excel, you would need to break it up and place the data on multiple sheets. This is not possible the straight import method you been using. The best you can do would be to read the CSV file with ADO into a Recordset object and then output the Recordset on to the individual sheets while specifying the number of records to be output.

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

Overall, this will be a fairly slow process. Why are you trying to display this in Excel? Something like Access maybe a better place to store the data (or even keep it in a CSV) and then connect to it from Excel for pivot tables and/or other analysis.

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