关于如何加速循环的建议

Question

我有以下代码。我想知道是否有一种简单的方法可以重写它，这样它运行起来的时间就会更短？目前，我要遍历大约13,000行，大约需要3-5分钟。谢谢!

Sheets("wkly").Activate

Dim i As Long

Lastrow = Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To Lastrow


If Range("S" & i) > 0.005 Then
        Range("Z" & i, "AA" & i).Copy
        Range("AC" & i, "AD" & i).PasteSpecial xlPasteValues
End If

Application.ScreenUpdating = False
Next i

Answer 1

给出了所有好的提示，并包括以下内容。请试一试，看看你能实现多少性能提升。

Application.Calculation = xlCalculationManual

lastrow = Range("S" & Rows.Count).End(xlUp).Rows
For i = 1 To lastrow
    If Range("S1").Offset(i) > 0.005 Then
            Range("AC").Offset(i).Resize(1, 2).Value = Range("Z").Offset(i).Resize(1, 2).Value
    End If
Next i

Answer 2

我相信这会让它变得更快。没有循环，也不需要复制和粘贴。

Application.ScreenUpdating = False
Application.Calculation = xlManual

Dim wks As Worksheet, Lastrow As Long
Set wks = Sheets("wkly")

With wks

    Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row

    .Range("S1:S" & Lastrow).AutoFilter 1, ">.005"

    'Assumes you will always have values greater than .005, if not you need to error trap
     Dim rngFilter As Range
     Set rngFilter = .Range("S2:S" & Lastrow).SpecialCells(xlCellTypeVisible) 'assumes row 1 is header row

     rngFilter.Offset(, 10).Value = rngFilter.Offset(, 7).Value
     rngFilter.Offset(, 11).Value = rngFilter.Offset(, 8).Value


End With

Application.ScreenUpdating = True

UPDATE我知道你已经接受了答案，但是如果你想知道如何通过使用数组循环来做到这一点，下面是：

Dim wks As Worksheet, varStore As Variant, Lastrow As Long, i As Long

Application.ScreenUpdating = False
Application.Calculation = xlManual

Set wks = Sheets("wkly")

With wks

    Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row

    varStore = .Range("S2:S" & Lastrow)

    For i = LBound(varStore, 1) To UBound(varStore, 1)

        If varStore(i, 1) > 0.005 Then .Range("AC" & i + 2 & ":AD" & i + 2).Value = .Range("Z" & i + 2 & ":AA" & i + 2).Value

    Next

End With

Application.ScreenUpdating = False