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 / text文件中的行数/记录数小于1,048,576（这是表格中excel的行限制）。现在，csv / text文件中的记录数是限制的10倍。

我需要帮助

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

感谢您对此的帮助。谢谢

Answer 1

您可以尝试以下代码。您需要将numOfLines变量的值更改为1046000或您需要的任何值。确保在Excel中打开了脚本库：工具＆gt;参考资料：Microsoft Scripting Control 1.0＆amp; 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连接到数据透视表和/或其他分析。

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

2 个答案: