加速VBA循环并避免StatusBar冻结

Question

我写了这个lopp：

ReDim TempTableID(1 To records, 1 To 1) As Variant
ReDim TempID(1 To lastrow + 13, 1 To 1) As Variant
    TempID = OppsClosed.Range("A14:A" & lastrow + 13).Value2
    k = 1

    For i = 1 To records
        'Progress bar
        Application.StatusBar = "Progress: " & i & " of " & records + 1 & ": " & Format(i / (records + 1), "0%")
        DoEvents 'Used to prevent Progress bar freezing

            TempTableID(i, 1) = TempID(k, 1)
            'TempTableID(i, 1) = OppsClosed.Range("A13").Offset(k, 0).Value2

            variable = i / nHeader

            If Fix(variable) = variable Then
                k = k + 1
            End If

    Next i

records = 1＆＃39; 000＆＃39; 000。循环需要大量的时间（1.5小时），因此我需要加快速度。当records大约为40＆000;我添加了DoEvents以避免状态栏冻结并让用户感觉循环正在运行。当然，我知道这会减慢这个过程。

问题是：＆＃34; 如何加快速度，避免冻结状态？＆＃34;

Ps简单来说，代码只需从第一个向量数组lastrow中获取[lastrow x 1]个元素，并复制第一个nHeader-times元素中的lastrow元素阵列。生成的数组为[lastrow*nHeader x 1]