时间戳

首页 > 解决方案 > Excel VBA - 每次执行后宏的执行时间变慢

excel - Excel VBA - 每次执行后宏的执行时间变慢

问题描述

我有一个代码如下：

  1. 刷新一个大约有 10.000 行的查询。

  2. 根据某些标准（我总共有十几个不同的 2D 数组）将数据拆分为各种 2D 数组。

  3. 将每个二维数组粘贴到不同的工作表中。

当我第一次运行宏需要约 18 秒，第二次运行约 30 秒，第三次运行约 35 秒，第四次运行约 45 秒，依此类推。查询中的数据在每次运行时都完全相同（它不会经常更改，或者最多可以更改一两行）。

如果有一些我不知道的记忆问题，有人可以解释一下吗？我还尝试将矩阵设置为等于 Nothing 后粘贴到工作表上，但这并没有改变每次运行的减速。任何帮助，将不胜感激。

PS 代码很长，我觉得把它都贴在这里没用。它或多或少地工作如下：

Sub GetMatrix()
    Dim Matrix As Variant, IndexMatrix As Long, i As Long, NoRows As Long
    IndexMatrix = 0
    ReDim Matrix(IndexMatrix, 2)
    NoRows = Application.CountA(Range("A:A"))
    For i = 2 To NoRows
        If Cells(i, 1) = "Something" Then
            Matrix(IndexMatrix, 0) = "Something"
            Matrix(IndexMatrix, 1) = "Something"
            Matrix(IndexMatrix, 2) = "Something"
            IndexMatrix = IndexMatrix + 1
            ReDim Preserve Matrix(IndexMatrix, 2)
        End If
    Next
    GetMatrix = Matrix
End Sub

标签： excelvba

解决方案

请尝试下一个改编的功能：

Function GetMatrix() As Variant
    Dim sh As Worksheet, arr As Variant, Matrix As Variant
    Dim IndexMatrix As Long, i As Long, LastRow As Long

    Set sh = ActiveSheet
    LastRow = sh.Range("A" & Rows.count).End(xlUp).Row
    arr = sh.Range("A1:A" & LastRow).Value
    ReDim Matrix(2, UBound(arr)) 'to admit redim preserve (only on the last dimension) at the end
    For i = 2 To LastRow
        If arr(i, 1) = "Something" Then
            Matrix(0, IndexMatrix) = "Something"
            Matrix(1, IndexMatrix) = "Something"
            Matrix(2, IndexMatrix) = "Something"
            IndexMatrix = IndexMatrix + 1
        End If
    Next
    ReDim Preserve Matrix(2, IndexMatrix - 1)
    GetMatrix = Matrix
End Function

推荐阅读