excel-Vba for循环，如果条件条件花费很长时间

Question

I am very much a novice with VBA but i have managed to write code that runs. My issue is that when i run it with many thousands of rows it basically grinds to a halt and nothing happens for well over an hour (when i run for 150K rows). On top of my code i have added:

I have also attempted to avoid using .select whenever i could. Is there anything that i'm missing or is there a way that i could improve my code? Since i've pasted various code i'm sure i've done something wrong.

Sub Eng11()

    Application.DisplayAlerts = False
    Application.AskToUpdateLinks = False
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Dim Last As Long
    Dim i As Long
    Dim wkb1 As Workbook
    Dim sht1 As Worksheet
    Dim wkb2 As Workbook
    Dim sht2 As Worksheet
    Dim lastrow As Long
    Dim sPath As String, sFile As String
    Dim wb As Workbook
    Dim x As Long
    Dim ws As Worksheet

    sPath = "C:\Users\nascd\Downloads\Pronto Master\"
    sFile = sPath & Sheets("Sheet 1").Range("J2").Text

    Set wkb1 = ThisWorkbook
    Set wkb2 = Workbooks.Open(sFile)
    Set sht1 = wkb1.Sheets("Data Table")
    Set sht2 = wkb2.Sheets("Sheet1")

    Set ws = sht2

    Last = Cells(Rows.Count, "AX").End(xlUp).Row
    For i = Last To 2 Step -1
        If (Cells(i, "AZ").Text) = (Cells(i, "AB").Text) And _
            (Cells(i, "BA").Text) = (Cells(i, "AC").Text) And _
            (Cells(i, "AY").Text) = "C" And (Cells(i, "AA").Text) = "E" Then

            Cells(i, "AX").Value = Cells(i, "Z").Value
            Cells(i, "AY").Value = Cells(i, "AA").Value
            Cells(i, "AZ").Value = Cells(i, "AB").Value
            Cells(i, "BA").Value = Cells(i, "AC").Value
        End If
    Next i

    For i = Last To 2 Step -1
        If (Cells(i, "AZ").Text) = (Cells(i, "AB").Text) And _
            (Cells(i, "BA").Text) = (Cells(i, "AC").Text) And _
            (Cells(i, "AY").Text) = "C" And (Cells(i, "AA").Text) = "T" Then

            Cells(i, "AX").Value = Cells(i, "Z").Value
            Cells(i, "AY").Value = Cells(i, "AA").Value
            Cells(i, "AZ").Value = Cells(i, "AB").Value
            Cells(i, "BA").Value = Cells(i, "AC").Value
        End If
    Next i

    For i = Last To 2 Step -1
        If (Cells(i, "AY").Text) = "1" And (Cells(i, "AA").Text) = "E" Then

            Cells(i, "AX").Value = Cells(i, "Z").Value
            Cells(i, "AY").Value = Cells(i, "AA").Value
            Cells(i, "AZ").Value = Cells(i, "AB").Value
            Cells(i, "BA").Value = Cells(i, "AC").Value
        End If
    Next i

    For i = Last To 2 Step -1
        If (Cells(i, "AY").Text) = "2" And (Cells(i, "AA").Text) = "E" Then

            Cells(i, "AX").Value = Cells(i, "Z").Value
            Cells(i, "AY").Value = Cells(i, "AA").Value
            Cells(i, "AZ").Value = Cells(i, "AB").Value
            Cells(i, "BA").Value = Cells(i, "AC").Value
        End If
    Next i
End Sub

Answer 1

I think that this is as condensed as I can make it. Certainly some logic magician could come in and make this shorter but I think they might not be able to fit the if logic onto a single line!

This will only loop once, which should have been your biggest obstacle in terms of time to run. I made sure to specify that you're searching in sht2 , removed some unused variables, and made sure to reset your application settings at the end of the sub. Other than that, the only thing I really did was combine your if statements as best as I could and put them into one loop.

Sub Eng11()

    With Application
        .DisplayAlerts = False
        .AskToUpdateLinks = False
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With


    Dim sht1 As Worksheet
    Set sht1 = ThisWorkbook.Sheets("Data Table")

    Dim sPath As String
    sPath = "C:\Users\nascd\Downloads\Pronto Master\"

    Dim sFile As String
    sFile = sPath & sht1.Range("J2").Value2

    Dim sht2 As Worksheet
    Set sht2 = Workbooks.Open(sFile).Sheets(1)


    Dim lastRow As Long
    lastRow = sht2.Cells(Rows.count, "AX").End(xlUp).row

    Dim i As Long
    For i = 2 To lastRow

        With sht2

            If .Cells(i, "AZ").Value2 = .Cells(i, "AB").Value2 And _
               .Cells(i, "BA").Value2 = .Cells(i, "AC").Value2 Then

                If .Cells(i, "AY").Value2 = "C" And _
                   (.Cells(i, "AA").Value2 = "E" Or .Cells(i, "AA").Value2 = "T") Then

                    .Cells(i, "AX").Value2 = .Cells(i, "Z").Value2
                    .Cells(i, "AY").Value2 = .Cells(i, "AA").Value2
                    .Cells(i, "AZ").Value2 = .Cells(i, "AB").Value2
                    .Cells(i, "BA").Value2 = .Cells(i, "AC").Value2

                End If

            ElseIf .Cells(i, "AA").Value2 = "E" And _
                   (.Cells(i, "AY").Value2 = 2 Or .Cells(i, "AY").Value2 = 1) Then

                .Cells(i, "AX").Value2 = .Cells(i, "Z").Value2
                .Cells(i, "AY").Value2 = .Cells(i, "AA").Value2
                .Cells(i, "AZ").Value2 = .Cells(i, "AB").Value2
                .Cells(i, "BA").Value2 = .Cells(i, "AC").Value2

            End If

        End With

    Next i


    With Application
        .DisplayAlerts = True
        .AskToUpdateLinks = True
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With

End Sub

Answer 2

Sub Eng11()

    Application.DisplayAlerts = False
    Application.AskToUpdateLinks = False
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False

    Dim Last As Long
    Dim i As Long
    Dim wkb1 As Workbook
    Dim sht1 As Worksheet
    Dim wkb2 As Workbook
    Dim sht2 As Worksheet
    Dim lastrow As Long
    Dim sPath As String, sFile As String
    Dim wb As Workbook
    Dim x As Long
    Dim ws As Worksheet

    sPath = "C:\Users\nascd\Downloads\Pronto Master\"
    sFile = sPath & Sheets("Sheet 1").Range("J2").Text

    Set wkb1 = ThisWorkbook
    Set wkb2 = Workbooks.Open(sFile)
    Set sht1 = wkb1.Sheets("Data Table")
    Set sht2 = wkb2.Sheets("Sheet1")

    Set ws = sht2

    Last = Cells(Rows.Count, "AX").End(xlUp).Row
    For i = Last To 2 Step -1
        If (Cells(i, "AZ").Text) = (Cells(i, "AB").Text) And _
            (Cells(i, "BA").Text) = (Cells(i, "AC").Text) And _
            (Cells(i, "AY").Text) = "C" And (Cells(i, "AA").Text) = "E" Then

            Cells(i, "AX").Value = Cells(i, "Z").Value
            Cells(i, "AY").Value = Cells(i, "AA").Value
            Cells(i, "AZ").Value = Cells(i, "AB").Value
            Cells(i, "BA").Value = Cells(i, "AC").Value
        End If


        If (Cells(i, "AZ").Text) = (Cells(i, "AB").Text) And _
            (Cells(i, "BA").Text) = (Cells(i, "AC").Text) And _
            (Cells(i, "AY").Text) = "C" And (Cells(i, "AA").Text) = "T" Then

            Cells(i, "AX").Value = Cells(i, "Z").Value
            Cells(i, "AY").Value = Cells(i, "AA").Value
            Cells(i, "AZ").Value = Cells(i, "AB").Value
            Cells(i, "BA").Value = Cells(i, "AC").Value
        End If

       If (Cells(i, "AY").Text) = "1" And (Cells(i, "AA").Text) = "E" Then

            Cells(i, "AX").Value = Cells(i, "Z").Value
            Cells(i, "AY").Value = Cells(i, "AA").Value
            Cells(i, "AZ").Value = Cells(i, "AB").Value
            Cells(i, "BA").Value = Cells(i, "AC").Value
        End If

        If (Cells(i, "AY").Text) = "2" And (Cells(i, "AA").Text) = "E" Then

            Cells(i, "AX").Value = Cells(i, "Z").Value
            Cells(i, "AY").Value = Cells(i, "AA").Value
            Cells(i, "AZ").Value = Cells(i, "AB").Value
            Cells(i, "BA").Value = Cells(i, "AC").Value
        End If
    Next i
End Sub

Can you pardon to let me the know the difference of last two Ifs as the function is same for both ifs condition.