arrays - Excel VBA : populating cells with array values is very slow

Question

我正在尝试为 QuickBooks 导出做一些数据格式化，一步很慢。我有一个名为“输出”的工作表，其中每个条目都以所需的格式排列，但我只希望将完全填充的条目用于另一个名为“ map ”的工作表上。

到目前为止，一切都是用公式完成的，这部分工作正常。我编写了一个小脚本来循环所有条目，并将相关信息从“输出”拉到五个不同的数组中。然后它循环回这些数组并填充“ map ”中适当列中的单元格。

我的脚本快速填充数组，但填充单元格需要很长时间。我使用 for 循环来迭代数组，每次迭代大约需要三秒钟，当您处理数千个条目时，这是一个非常长的时间。

Sub Prettify()

    Dim numbers()
    Dim catagories()
    Dim classes()
    Dim subclasses()
    Dim values()

    Dim count As Integer

    count = 2

    ' The upper bounds of the loop is a calculation of the number of entries we will access

    For i = 2 To (Sheets("Data").Cells(7, 8).Value * Sheets("Data").Cells(4, 3).Value + 2)


        If (Sheets("Output").Cells(i, 1).Value = "") Then

            ' Do Nothing

        Else

            ReDim Preserve numbers(count)
            ReDim Preserve catagories(count)
            ReDim Preserve classes(count)
            ReDim Preserve subclasses(count)
            ReDim Preserve values(count)

            count = count + 1

            numbers(count - 2) = Val((Sheets("Output").Cells(i, 1).Value))
            catagories(count - 2) = Sheets("Output").Cells(i, 2).Value

            If (Sheets("Output").Cells(i, 3).Value = 0) Then

                classes(count - 2) = Sheets("Output").Cells(i, 4).Value
                subclasses(count - 2) = ""

            Else

                classes(count - 2) = Sheets("Output").Cells(i, 3).Value
                subclasses(count - 2) = Sheets("Output").Cells(i, 4).Value

            End If

            values(count - 2) = Sheets("Output").Cells(i, 5).Value

        End If

    Next

    MsgBox (numbers(0))
    MsgBox (catagories(0))

    Sheets("Map").Activate

    '  This next part is slow

    For j = 2 To count

        Sheets("Map").Cells(j, 1).Value = numbers(j - 2)
        Sheets("Map").Cells(j, 2).Value = catagories(j - 2)
        Sheets("Map").Cells(j, 3).Value = classes(j - 2)
        Sheets("Map").Cells(j, 4).Value = subclasses(j - 2)
        Sheets("Map").Cells(j, 5).Value = values(j - 2)

    Next

End Sub

大约三年前，我在一篇帖子中有一个类似的问题，但他们使用的修复程序不适用于我的示例。我使用消息框在不同点测试了代码，最后一个 for 循环中的五个分配步骤中的每一个都同样慢。想法？

Answer 1

我遇到了这个问题，问题是您的代码一个接一个地访问每个单元格。关闭屏幕和事件会有所帮助，但它仍然会很慢并且会因更大的阵列而瘫痪。

解决方案是一次性将所有东​​西都倾倒到细胞中。为此，您需要使用多维数组。这听起来很复杂，但一旦你了解它就不会了。

看起来好像您正在以同样的方式从工作簿中获取数据。

这是一些应该对其进行排序的代码，它看起来非常简单，但它确实有效。

Dim v_Data() as variant
Dim range_to_Load as range
Dim y as long, x as long
'set a range or better still use a list object
set range_to_Load = thisworkbook.sheets("Data").Range("A1:F100")
'Load the range into a variant array.
with range_to_Load
    redim v_data(1 to .rows.count, 1 to .columns.count)
    v_data = .value
end with
' v_data now holds all in the range but as a multidimentional array
' to access it its going to be like a grid so 
v_data(row in the range, column in the range)
'Loop through the array, I'm going to covert everything to a string then
'dump it in the Map sheet you have
' you should avoid x,y as variables however this is a good use as they are coordinate values.
'lbound and ubound will loop y though everything by row as it is the first dimension in the array. 
For y = lbound(v_data) to ubound(v_data) 
    ' next we are going to do the same but for the second dimention
    For x = lbound(v_data,2) to ubound(v_data,2)
         vdata(y,x) = cstr(v_data(y,x))
    Next x
Next y
'We have done something with the array and now want to put it somewhere, we could just drop it where we got it from to do this we  would say
range_to_Load.value = v_data
' to put it else where
thisworkbook.sheets("Map").range("A1").resize(ubound(v_data), ubound(v_data,2)).value = v_data

那应该可以解决您的问题，您可以做很多事情。阅读多维数组，Chip Pearson 像往常一样有很多话要说，并且会有所帮助。

您可以在几秒钟内而不是几分钟内处理大量集合，因为在数组中所有操作都在内存中完成，只有在您获取数据并将其放回时才能访问工作簿，从而真正最大限度地减少运行代码所需的时间。