Question

只是想知道是否有人可以提供任何可能提高我的代码将数组写入工作簿的速度的建议。

我正在将大约190万行数据写入工作簿中的多个工作表，一次一页。代码完成后，写入excel工作簿需要大约18个小时，这看起来非常过分。这是设置。我这样打开工作簿：

Dim ExcelAp As Excel.Application
Dim ouputWorkbook As Excel.Workbook

Set ExcelAp = New Excel.Application
Set outputWorkbook = ExcelAp.Workbooks.Open("S:\Some Directory\Template.xlsx")

然后我将数组中的工作簿行加载到集合中，然后遍历工作簿中的范围以复制数组：

For lonSheetOneCounter = 2 to 999999
    outputWorkbook.Worksheets(1).Range(_
        outputWorkbook.Worksheets(1).Cells(lonSheetOneCounter, 1).Address & ":" & _
        outputWorkbook.Worksheets(1).Cells(lonSheetOneCounter, 21).Address).Value = _
        outputCollection.item(lonSheetOneCounter - 1)
Next lonSheetOneCounter

其他工作表的复制方法相同。我已经作出的excel不可见的，我已切换计算的工作簿和实例为手动对于工作簿，我也关闭屏幕更新，但是它仍然需要约18小时给予或采取以完成复制到新的工作簿。< / p>

我已经尝试为neier表创建一个二维数组，但无论我使用哪种方法，我都会在尝试将该数组复制到工作簿时出现“内存不足错误”。

我不确定我能做些什么来弥补错误并缩短复制时间，但如果有人有建议，我会全力以赴。对于它的价值，这个宏被安置在另一个excel工作簿中，该工作簿是在我试图复制到的工作簿的单独的excel实例中运行的。

编辑：这里有轻微的补充。我注意到我想引起注意的东西也让我觉得有可能加快这个过程。我注意到宏会逐渐减慢。第一个X行的写入速度非常快，随着每行写入，以下行似乎越来越慢......

我将尝试一个实验，我将模板设置为自动加载一个包含100万行的电子表格......有点是由底部的建议提示的。我想知道excel是否必须为所有额外的行分配内存。也许如果我开始使用已经设置了这么多行的工作簿模板，我可能会更容易理解。

编辑：有人向我指出，我不清楚我正在阅读的数据来自哪里。使用来自许多文本文件的VBA原语读入该数据。一个是管道分隔的，另外两个是逗号，而不是文件的方案有很大的不同。

就填充数组而言，这是一个如何发生的片段。看起来一团糟但是根据我正在比较的三个文件的格式，没有任何其他方法可以使数据匹配。无论如何，现在我将所有内容放入大型，大型数组中，这就是我填充这些数组的方式。到arrViLine和arrNonIraLine和arrIraLine的参考文献仅仅是该文件的线被从它们的原始管和逗号分隔的格式解析成数组：

    If arrViLine(2) = arrIraLine(1) Or arrViLine(2) = arrNonIraLine(1) Then
        If arrViLine(2) = arrIraLine(1) Then
            boolVi = True
            boolIra = True
            boolNonIra = False
            If lonMatchCounter <= 999999 Then
                matchOneArray(lonMatchCounter, 1) = arrViLine(1)
                matchOneArray(lonMatchCounter, 2) = arrViLine(2)
                matchOneArray(lonMatchCounter, 3) = arrIraLine(2)
                matchOneArray(lonMatchCounter, 4) = arrIraLine(3)
                matchOneArray(lonMatchCounter, 5) = arrViLine(3)
                matchOneArray(lonMatchCounter, 6) = arrViLine(4)
                matchOneArray(lonMatchCounter, 7) = arrIraLine(4)
                matchOneArray(lonMatchCounter, 8) = arrViLine(6)
                matchOneArray(lonMatchCounter, 9) = arrViLine(5)
                matchOneArray(lonMatchCounter, 10) = arrViLine(7)
                matchOneArray(lonMatchCounter, 11) = arrViLine(8)
                matchOneArray(lonMatchCounter, 12) = arrViLine(9)
                matchOneArray(lonMatchCounter, 13) = arrViLine(10)
                matchOneArray(lonMatchCounter, 14) = arrViLine(11)
                matchOneArray(lonMatchCounter, 15) = arrViLine(12)
                matchOneArray(lonMatchCounter, 16) = arrIraLine(5)
                matchOneArray(lonMatchCounter, 17) = arrIraLine(6)
                matchOneArray(lonMatchCounter, 18) = arrViLine(13)
                matchOneArray(lonMatchCounter, 19) = arrViLine(14)
                matchOneArray(lonMatchCounter, 20) = "IRA"
                matchOneArray(lonMatchCounter, 21) = arrViLine(15)
                lonMatchCounter = lonMatchCounter + 1
            Else
                lonMatchTwoCounter = lonMatchCounter - 999999
                matchTwoArray(lonMatchTwoCounter, 1) = arrViLine(1)
                matchTwoArray(lonMatchTwoCounter, 2) = arrViLine(2)
                matchTwoArray(lonMatchTwoCounter, 3) = arrIraLine(2)
                matchTwoArray(lonMatchTwoCounter, 4) = arrIraLine(3)
                matchTwoArray(lonMatchTwoCounter, 5) = arrViLine(3)
                matchTwoArray(lonMatchTwoCounter, 6) = arrViLine(4)
                matchTwoArray(lonMatchTwoCounter, 7) = arrIraLine(4)
                matchTwoArray(lonMatchTwoCounter, 8) = arrViLine(6)
                matchTwoArray(lonMatchTwoCounter, 9) = arrViLine(5)
                matchTwoArray(lonMatchTwoCounter, 10) = arrViLine(7)
                matchTwoArray(lonMatchTwoCounter, 11) = arrViLine(8)
                matchTwoArray(lonMatchTwoCounter, 12) = arrViLine(9)
                matchTwoArray(lonMatchTwoCounter, 13) = arrViLine(10)
                matchTwoArray(lonMatchTwoCounter, 14) = arrViLine(11)
                matchTwoArray(lonMatchTwoCounter, 15) = arrViLine(12)
                matchTwoArray(lonMatchTwoCounter, 16) = arrIraLine(5)
                matchTwoArray(lonMatchTwoCounter, 17) = arrIraLine(6)
                matchTwoArray(lonMatchTwoCounter, 18) = arrViLine(13)
                matchTwoArray(lonMatchTwoCounter, 19) = arrViLine(14)
                matchTwoArray(lonMatchTwoCounter, 20) = "IRA"
                matchTwoArray(lonMatchTwoCounter, 21) = arrViLine(15)
                lonMatchCounter = lonMatchCounter + 1
            End If
        Else 'arrViLine(2) must = arrNonIraLine(1)
            boolVi = True
            boolIra = False
            boolNonIra = True
            If lonMatchCounter <= 999999 Then
                matchOneArray(lonMatchCounter, 1) = arrViLine(1)
                matchOneArray(lonMatchCounter, 2) = arrViLine(2)
                matchOneArray(lonMatchCounter, 3) = arrNonIraLine(2)
                matchOneArray(lonMatchCounter, 4) = arrNonIraLine(3)
                matchOneArray(lonMatchCounter, 5) = arrViLine(3)
                matchOneArray(lonMatchCounter, 6) = arrViLine(4)
                matchOneArray(lonMatchCounter, 7) = arrNonIraLine(5)
                matchOneArray(lonMatchCounter, 8) = arrViLine(6)
                matchOneArray(lonMatchCounter, 9) = arrViLine(5)
                matchOneArray(lonMatchCounter, 10) = arrViLine(7)
                matchOneArray(lonMatchCounter, 11) = arrViLine(8)
                matchOneArray(lonMatchCounter, 12) = arrViLine(9)
                matchOneArray(lonMatchCounter, 13) = arrViLine(10)
                matchOneArray(lonMatchCounter, 14) = arrViLine(11)
                matchOneArray(lonMatchCounter, 15) = arrViLine(12)
                matchOneArray(lonMatchCounter, 16) = arrNonIraLine(4)
                matchOneArray(lonMatchCounter, 17) = arrNonIraLine(6)
                matchOneArray(lonMatchCounter, 18) = arrViLine(13)
                matchOneArray(lonMatchCounter, 19) = arrViLine(14)
                matchOneArray(lonMatchCounter, 20) = "IRA"
                matchOneArray(lonMatchCounter, 21) = arrViLine(15)
                lonMatchCounter = lonMatchCounter + 1
            Else
                lonMatchTwoCounter = lonMatchCounter - 999999
                matchTwoArray(lonMatchTwoCounter, 1) = arrViLine(1)
                matchTwoArray(lonMatchTwoCounter, 2) = arrViLine(2)
                matchTwoArray(lonMatchTwoCounter, 3) = arrNonIraLine(2)
                matchTwoArray(lonMatchTwoCounter, 4) = arrNonIraLine(3)
                matchTwoArray(lonMatchTwoCounter, 5) = arrViLine(3)
                matchTwoArray(lonMatchTwoCounter, 6) = arrViLine(4)
                matchTwoArray(lonMatchTwoCounter, 7) = arrNonIraLine(5)
                matchTwoArray(lonMatchTwoCounter, 8) = arrViLine(6)
                matchTwoArray(lonMatchTwoCounter, 9) = arrViLine(5)
                matchTwoArray(lonMatchTwoCounter, 10) = arrViLine(7)
                matchTwoArray(lonMatchTwoCounter, 11) = arrViLine(8)
                matchTwoArray(lonMatchTwoCounter, 12) = arrViLine(9)
                matchTwoArray(lonMatchTwoCounter, 13) = arrViLine(10)
                matchTwoArray(lonMatchTwoCounter, 14) = arrViLine(11)
                matchTwoArray(lonMatchTwoCounter, 15) = arrViLine(12)
                matchTwoArray(lonMatchTwoCounter, 16) = arrNonIraLine(4)
                matchTwoArray(lonMatchTwoCounter, 17) = arrNonIraLine(6)
                matchTwoArray(lonMatchTwoCounter, 18) = arrViLine(13)
                matchTwoArray(lonMatchTwoCounter, 19) = arrViLine(14)
                matchTwoArray(lonMatchTwoCounter, 20) = "Non-IRA"
                matchTwoArray(lonMatchTwoCounter, 21) = arrViLine(15)
                lonMatchCounter = lonMatchCounter + 1
            End If
        End If

你也可以忽略布尔变量，它们可以提示宏是否应该在下一个循环中读取特定文件的下一行。

编辑：并不是说它对我将数据写入excel的速度有多大影响，请考虑以下行作为我正在使用的文件格式的一个示例。

“主人”档案：

Account Number|ID Number|Int Rate|Cum Int|Agreement|Type
12345|111111|.005|.01234|"C"|"IRA"
12346|111112|.005|.02345|"A"|"Non-IRA"
12347|111113|.004|.02345|"B"|"Non-IRA"

匹配文件一：

ID Number|Int Rate|Cum Int|Type
111111|.004|.01234|"IRA"

匹配文件二：

ID Number|Int Rate|Cum Int|Type
111113|.004|.02345|"Non-IRA"

所以这只是我正在使用的一个小例子。按ID号按顺序列出的文本文件和CSV文件。在上面的示例中，宏将匹配master的第一行以匹配文件1，并将来自两个文件的所有字段中的数据记录到将输出到excel电子表格的数组中。然后，宏读取主文件的下一行并匹配文件1，但是将文件从第二行循环到下一个循环。主机的下一行将没有匹配，并记录在工作簿的单独工作表上。 master的最后一行匹配文件二，并记录到与第一个匹配相同的数组。

这就是例程的工作原理，我所遇到的真正问题是数据写入excel工作簿的速度。我正在努力将数据分成几列。

Answer 1

您不需要集合：只需将工作表中的数据分配到单个变体中，然后将变量分配回新工作表。

要最小化内存等，请尝试在工作表上使用UsedRange。此示例一次复制一列：使用Excel 2010 32位将1百万行从1个工作表复制到另一个工作表需要35秒，

 Sub getting()
    Dim var As Variant
    Dim j As Long
    Dim dTime As Double
    dTime = Now
    For j = 1 To 21
        var = Worksheets("Sheet3").UsedRange.Resize(, 1).Offset(0, j - 1).Value2
        Worksheets("Sheet1").Range("a1").Resize(UBound(var), UBound(var, 2)).Offset(0, j - 1) = var
    Next j
    MsgBox CStr(Now - dTime)
End Sub

Answer 2

我试图测试这个将有50万行进入数组，但是出现内存不足错误。你没有说你是如何填充你的集合/数组，但我认为你能够做到这一点。为了演示目的，我最终得到了400k x 21阵列。

一直在拍摄的部分是你一次写入21张单元格。写入工作表是Excel VBA中最耗时的工作，因此您需要尽可能减少该操作。

对于这个概念证明，我读了400k x 21个数据。我以100k行的增量将它们写入不同的纸张。为了您的目的，您应该创建内存可以处理的最大块数组。

Sub WriteDataToFiles()

    Dim vaData As Variant
    Dim vaChunk() As Variant
    Dim lStep As Long
    Dim i As Long, j As Long, k As Long
    Dim wb As Workbook, sh As Worksheet
    Dim lStart As Long

    lStart = Timer

    'Process in 100,000 row increments
    lStep = 10 ^ 5

    'Fill a big array with a bunch of data
    FillDataArray vaData
    'Show how big the array is
    Debug.Print UBound(vaData, 1) & " x " & UBound(vaData, 2)

    'Create a new workbook to write to
    Set wb = Workbooks.Add

    'loop through the big array in 100k increments
    For i = LBound(vaData, 1) To UBound(vaData, 1) Step lStep

        'dimension a smaller range to hold a subset of the big array
        ReDim vaChunk(1 To lStep, 1 To 21) 'clean out array

        'fill the smaller array with data from big array
        For j = LBound(vaChunk) To UBound(vaChunk)
            For k = 1 To 21
                vaChunk(j, k) = vaData(i + j - 1, k)
            Next k
        Next j

        'Add a new sheet
        Set sh = wb.Worksheets.Add

        'Write the small array to the sheet
        sh.Range("A1").Resize(UBound(vaChunk, 1), UBound(vaChunk, 2)).Value = vaChunk

    Next i

    'See how long it takes
    Debug.Print Timer - lStart

End Sub

从立即窗口：

400000 x 21
 8.68359375

在我悲伤的PC上大约9秒钟将400k行分成四张。我在每张纸上放了100k，但我可以放更多。即使您以100k行增量工作，您仍然可以将它们放在同一张纸上。我需要将您的块写入下一个单元格，并跟踪下一个单元格的位置，而不是代码中的“A1”。然后，当下一个单元格> 10 ^ 6行，您创建一个新工作表并重新开始。

总之，将数据放入最大的二维数组中，并将其一次写入工作表。写入越少，代码就越快。

Answer 3

你对逐渐变慢的写入的描述让我怀疑你在使用Collection的索引时遇到了O（n ^ 2）问题。

所以试试这个：而不是像现在一样对集合进行索引：

For lonSheetOneCounter = 2 to 999999
    outputWorkbook.Worksheets(1).Range(_
        outputWorkbook.Worksheets(1).Cells(lonSheetOneCounter, 1).Address & ":" & _
        outputWorkbook.Worksheets(1).Cells(lonSheetOneCounter, 21).Address).Value = _
        outputCollection.item(lonSheetOneCounter - 1)
Next lonSheetOneCounter

请尝试枚举它：

lonSheetOneCounter = 2
For each item In outputCollection
    outputWorkbook.Worksheets(1).Range(_
        outputWorkbook.Worksheets(1).Cells(lonSheetOneCounter, 1).Address & ":" & _
        outputWorkbook.Worksheets(1).Cells(lonSheetOneCounter, 21).Address).Value = _
        item
    lonSheetOneCounter = lonSheetOneCounter + 1
Next

你知道，鉴于这是VBA并且你正在执行循环体一百万次，本地化你的引用并使用直接范围规格而不是字符串也不会有害：

lonSheetOneCounter = 2
Dim ws As Worksheet
Set ws = outputWorkbook.Worksheets(1)
For each item In outputCollection
    ws.Range( _
        ws.Cells(lonSheetOneCounter, 1), ws.Cells(lonSheetOneCounter, 21)
            ).Value = item
    lonSheetOneCounter = lonSheetOneCounter + 1
Next

Answer 4

首先，我认为您使用的是错误的工具集。 VBA无法处理大量数据，并且按值写入值非常慢。

最合适的方法是使用Recordsets从文件中获取数据并将其转储到模板上

我假设：

您的文件与包含代码的工作簿位于同一文件夹中
有一个名为master.csv（管道分隔）的文件和名为ira.csv和non_ira.csv的文件，两者都以逗号分隔

话虽如此，您的日常工作可以分为三个步骤：

创建schema.ini文件
使用ActiveX数据对象库从文件中获取数据
将数据转储到工作簿

第1步： schema.ini文件

此步骤是必需的，因为您的文件没有相同的分隔符。此步骤只需要您创建名为schema.ini的文件在与您的数据相同的文件夹中并粘贴下面的代码：

[master.csv]
DecimalSymbol=.
Format=Delimited(|)
ColNameHeader=True

[ira.csv]
DecimalSymbol=. 
Format=Delimited(,)
ColNameHeader=True

[non_ira.csv]
DecimalSymbol=. 
Format=Delimited(,)
ColNameHeader=True

此文件可用于指定数据的各种属性。有关详细信息，请参阅此link

第2步：使用ActiveX数据对象库从文件中获取数据

首先，您需要添加对ActiveX Data Objects库的引用。为此，请打开VBA编辑器，然后转到Tools＆gt; References并进行检查 Microsoft ActiveX Data Objects library。在您的数据上使用SQL查询时需要执行此步骤。

接下来，您必须编写代码来配置与数据的连接，如下所示：

Private Function CreateConnection(folderPath As String) As ADODB.Connection

    Dim conStr As String

    conStr = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
             "Data Source=" & Replace(folderPath, "\", "\\") & ";" & _
             "Extended Properties=""text;HDR=Yes;IMEX=1;FMT=Delimited"";"

    Set CreateConnection = New ADODB.Connection
    CreateConnection.Open conStr

End Function

然后，您可以编写一个函数来基于自定义SQL查询创建记录集，如下所示：

Private Function GetData(cnn As ADODB.Connection, file As String) As ADODB.Recordset

    Dim strSql As String

    Const adOpenStatic = 3
    Const adLockOptimistic = 3
    Const adCmdText = &H1
    'You'll need to change this variable to match your needs
    strSql = "SELECT master.[Account Number], " & _
                   " master.[ID Number], " & _
                   " file.[Int Rate], " & _
                   " file.[Cum Int] " & _
              "FROM [master.csv] master INNER JOIN [" & file & ".csv] file ON master.[ID Number] = file.[ID Number]"
   Set GetData = New Recordset
   GetData.Open strSql, cnn, adOpenStatic, adLockOptimistic, adCmdText

End Function

此函数将返回一个记录集，其中包含master和file共有的数据，使用ID Number作为键

第3步：将数据转储到工作簿

为此，你可以这样写：

Public Sub LoadData()
    Dim cnn As ADODB.Connection
    Dim rsIRA As ADODB.Recordset, rsNonIRA As ADODB.Recordset
    Dim wbk As Workbook

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False

    'In this example the files and this workbook are in the same folder
    Set cnn = CreateConnection(ThisWorkbook.Path & "\")

    Set rsIRA = GetData(cnn, "ira")
    Set rsNonIRA = GetData(cnn, "non_ira")

    Set wbk = Workbooks.Open("S:\Some Directory\Template.xlsx")

    'Dumps the data from the recordset
    wbk.Worksheets(1).Range("A2").CopyFromRecordset rsIRA
    wbk.Worksheets(1).Range("A2").Offset(rsIRA.RecordCount, 0).CopyFromRecordset rsNonIRA

    Application.ScreenUpdating = True

    'Clean up
    rsIRA.Close
    rsNonIRA.Close
    cnn.Close
    Set rsIRA = Nothing
    Set rsNonIRA = Nothing
    Set cnn = Nothing

End Sub

我使用您提供的数据样本进行了测试，但它确实有效。您必须根据需要调整代码我认为它会运行得更快，因为它只处理DB / Excel API，消除了VBA瓶颈

VBA慢速编写数组以优化工作簿

4 个答案: