Question

我已经整理了一个简单的宏来筛选A列并将每3行转换成一行...... （即A1，A2，A3转到A1，B1，C1，A4，A5，A6转到A2，B2，C2等......）

它的效果非常好，但是，我会将范围推到最大，即尝试去rows.count

我想知道是否有人对如何加速代码有所了解，需要大约40秒才能通过200,000行，并在此之后的某个时间点出一些炸弹（91错误）....

有关改进的任何想法？

这是代码：

Sub arrsampWORKS1()
    Dim array_example(3)
    Dim Destination As Range
    Dim p As Double

    'StartTime = Timer

    For q = 0 To 40
        p = q * 3
        'Storing values in the array
        For i = 0 To 2
            array_example(i) = Range("A" & i + 1 + p)
        Next

        Set Destination = Range(Cells(q + 1, 4), Cells(q + 1, 7))
        Set Destination = Destination.Resize(1, 3)
        Destination.Value = array_example
    Next
    'MsgBox Timer - StartTime & " seconds"
End Sub

Answer 1

一般来说，如果我想要一个更高效的宏，我会在宏的开头关闭屏幕更新和自动计算。默认情况下，每次更改时，excel都会更新打开的工作簿中的每个公式。

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

在宏的末尾，我重新启用它们

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

这大大缩短了时间，但只有在您不需要重新计算所有内容时才有用。

如果您需要在宏中的给定时间进行计算，则可以使用

Application.Calculate 'calculate everything
wksht.Calculate 'calculate a specified worksheet

如果您仍需要更好的性能，请开始重新编写代码。

Answer 2

写入电子表格和设置范围需要一些时间来初始化，通常可以通过在内存中存储更多项目然后在最后写入来节省时间。

我会将你的代码改为2个循环 - 首先读取所有数据并创建一个保存信息的临时变量，然后是输出所有数据的第二个循环。

Sub revised()

Dim array_example(3) As Variant, alldata() As Variant
Dim Destination As Range, Data As Range
Dim p As Double, iCount As Double, iArraysCount As Double
Dim step As Integer

'StartTime = Timer
Set Data = Range("A1")
ReDim Preserve alldata(0)
iArraysCount = 0
step = 3

    For iCount = 1 To 45 Step step
            'Storing values in the array
            For i = 0 To 2
                array_example(i) = Data.Cells(iCount + i)
            Next
            ReDim Preserve alldata(iArraysCount)
            alldata(iArraysCount) = array_example
            iArraysCount = iArraysCount + 1
    Next

Set Destination = Range("B1")
For iCount = 0 To UBound(alldata)
        Destination.Cells(iCount + 1, 1).Value = alldata(iCount)(0)
        Destination.Cells(iCount + 1, 2).Value = alldata(iCount)(1)
        Destination.Cells(iCount + 1, 3).Value = alldata(iCount)(2)
Next
'MsgBox Timer - StartTime & " seconds"

End Sub

我可以加速这个VBA代码吗？

2 个答案: