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.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

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

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

Answer 2

如果对大量单元格进行操作，将它们复制到数组中并在处理后将其写回通常是最快的。以下代码在我的机器上以0.04秒运行（基于Scott的答案，但也使用数组进行编写）：


Dim wks As Worksheet
Dim varCompare As Variant, varSource As Variant, varTarget As Variant
Dim 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

    varCompare = .Range("S2:S" & Lastrow)
    varSource = .Range("Z2:AD" & Lastrow)
    varTarget = .Range("AC2:AD" & Lastrow)
    For i = LBound(varCompare, 1) To UBound(varCompare, 1)

        If varCompare(i, 1) > 0.005 Then
            varTarget(i, 1) = varSource(i, 1)
            varTarget(i, 2) = varSource(i, 2)
        End If
    Next

    .Range("AC2:AD" & Lastrow).Value = varTarget
End With

Application.ScreenUpdating = False

Answer 3

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

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

关于如何加快循环的建议

3 个答案: