有没有办法让具有多个条件标准的循环运行得更快

Question

我在循环中需要满足多个条件，我认为这就是让它变慢的原因。每次我添加一个新条件，它都会变得更慢。关于如何让它运行得更快有什么建议吗？请参阅下面的代码。

Sub A1_GET_DATA()
'Clear Range
Sheets("Sheet2").Select
Cells.Select
Selection.ClearContents

'Declare Variables
Dim LastRow1 As Integer
Dim LastRow2 As Integer


'Establish Loop
LastRow1 = Worksheets("Sheet1").Cells(Rows.Count, 7).End(xlUp).Row


For i = 14 To LastRow1

'Condition for Loop
If Worksheets("Sheet1").Cells(i, 7).Value <> "" Then
    Worksheets("Sheet1").Rows(i).Copy
    Worksheets("Sheet2").Activate
    LastRow2 = Worksheets("Sheet2").Cells(Rows.Count, 7).End(xlUp).Row
    Worksheets("Sheet2").Cells(LastRow2 + 1, 1).Select
    ActiveSheet.Paste
Application.CutCopyMode = False

Worksheets("sheet1").Cells(i - 1, 1).Copy
Worksheets("Sheet2").Activate
    LastRow2 = Worksheets("Sheet2").Cells(Rows.Count, 7).End(xlUp).Row
    Worksheets("Sheet2").Cells(LastRow2, 20).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
    If Worksheets("Sheet2").Cells(LastRow2, 20).Value = "" Then
    Worksheets("Sheet2").Cells(LastRow2, 20).Select
    Selection.FillDown
    Application.CutCopyMode = False
    End If
    
    

End If
Next

Answer 1

• 使用

  Select

  Active

  会使代码变慢

如何避免在 Excel VBA 中使用 Select

Option Explicit

Sub A1_GET_DATA()
    'Declare Variables
    Dim LastRow1 As Long, LastRow2 As Long, i As Long
    Dim oSht1 As Worksheet, oSht2 As Worksheet
    Set oSht1 = Sheets("Sheet1")
    Set oSht2 = Sheets("Sheet2")
    'Establish Loop
    LastRow1 = oSht1.Cells(oSht1.Rows.Count, 7).End(xlUp).Row
    With oSht2
        'Clear Range
        .Cells.ClearContents
        For i = 14 To LastRow1
            'Condition for Loop
            If Len(oSht1.Cells(i, 7).Value) > 0 Then
                LastRow2 = .Cells(.Rows.Count, 7).End(xlUp).Row
                oSht1.Rows(i).Copy .Cells(LastRow2 + 1, 1)
                LastRow2 = .Cells(.Rows.Count, 7).End(xlUp).Row
                oSht1.Cells(i - 1, 1).Copy .Cells(LastRow2, 20)
                If .Cells(LastRow2, 20).Value = "" Then
                    .Cells(LastRow2, 20).Formula2R1C1 = .Cells(LastRow2 - 1, 20).Formula2R1C1
                End If
            End If
        Next
    End With
End Sub