Vba 导入大型CSV时Excel处于冻结状态

我有一个非常大的CSV文件，有60列和50k行。（我无法向您展示，因为它位于内部网中。）

我编写了VBA代码，可以执行以下操作：

Columns("D:BF").Select
Selection.ClearContents
*Code to import csv file to D1*
LastRow = Cells(Rows.Count, "D").End(xlUp).Row
Range("A1:C1").Select
Selection.Copy
Range("A2:C" & lastrow).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False

它正在工作，但已停止工作。当我运行宏时，Excel冻结。我需要按“Esc”键，宏停止，然后调试器说PasteSpecial错误。 但事实并非如此，如果我运行一个宏只是为了导入，然后按“Esc”，它导入得非常好，然后我运行第二个宏粘贴公式，直到最后一行，它运行得也非常好

该工作簿正在手动计算中

---

粘贴后使用

doevents

命令…我希望它能工作

将CSV文件逐行读取到10000行100列的数组中。当数组已满时，我将其写入Excel，重新分配数组并继续，直到文件结束

我最初尝试使用动态数组，但它会冻结。使用静态数组实际上效率更高

您需要调整常量值。从图像上看，文件似乎以分号分隔。只要

ColumnCount

大于或等于实际列计数，那么它是否精确就很重要

Const CSVFileName = "C:\Users\best buy\Downloads\stackoverfow\Sample Data File\R58K x C60.csv"
Const Delimiter = ","
Const PageSize = 10000
Const ColumnCount = 100

导入100000行和64列大约需要32秒。磁盘上的CSV文件为69.5 MB

---

#felipe31你确定你的密码吗？！？！？选择单元格（“D:BF”）并清除这些单元格，最后一行将是D1@Fabrizio OP在导入新数据之前正在清除旧数据。@ThomasInzina在Excel 2010和更高版本中是正确的，您可以尝试使用Power QueryI导入。我明天会尝试，我告诉您它不起作用，问题在于导入。我做了一个宏只是为了导入，它一直冻结，我需要按ESC如果“问题在于导入”，那么你应该发布此代码：“将csv文件导入D1的代码”发布了链接。你的代码只是一个标准文本文件导入。我不知道为什么它停止工作了。我会发布代码并将文件路径更改为

C:\Users\Data Files\sample.xlsm

。大约一个小时后，我将更新我的答案，逐行读取并导入csv文件。这将是一个缓慢的坚果不应该冻结。

Option Explicit

Sub ProcessFile()
    Const CSVFileName = "C:\Users\best buy\Downloads\stackoverfow\Sample Data File\R58K x C60.csv"
    Const Delimiter = ","

    ActiveSheet.DisplayPageBreaks = False
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

    Debug.Print Now
    Dim Start: Start = Timer

    Dim lastRow As Long
    Dim arFormulas
    arFormulas = Range("A1:C1").Formula

    Columns("A:BF").ClearContents

    ImportCSVFile CSVFileName, Delimiter

    Debug.Print "Time to import CSV file in seconds:"; Timer - Start
    Start = Timer

    lastRow = Cells(Rows.Count, "D").End(xlUp).Row

    Range("A1:C" & lastRow).Formula = arFormulas

    Debug.Print "Time to add formulas in seconds:"; Timer - Start

    Debug.Print "Column Count:"; Worksheets("Sheet1").UsedRange.Columns.Count
    Debug.Print "Row Count:"; Worksheets("Sheet1").UsedRange.Rows.Count

    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .AutoRecover.Enabled = True
    End With
End Sub

Sub ImportCSVFile(FilePath As String, Delimiter As String)
    Const PageSize = 10000
    Const ColumnCount = 100

    Dim line As String
    Dim arData, arLine
    Dim x As Long, y As Long, z As Long
    ReDim arData(PageSize, ColumnCount)
    z = 1

    Open FilePath For Input As #1                     ' Open file for input
    Do While Not EOF(1)                               ' Loop until end of file
        Line Input #1, line
        arLine = Split(line, Delimiter)

        y = 0
        For y = 0 To UBound(arLine)
            arData(x, y) = arLine(y)
        Next
        x = x + 1

        If x = PageSize Or EOF(1) Then

            Range("D" & z).Resize(x, y) = arData
            z = z + x
            ReDim arData(PageSize, ColumnCount)
            x = 0
        End If

    Loop

    Close #1

    Erase arData
End Sub