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

时间:2018-07-24 12:50:27

标签: excel vba excel-vba

我是VBA的新手,但是我设法编写了可以运行的代码。我的问题是,当我运行成千上万的行时,它基本上会停止运行,并且在一个多小时内没有任何反应(当我运行15万行时)。在我的代码之上,我添加了:

我还尝试尽可能避免使用.select。有什么我缺少的东西,或者有什么方法可以改善我的代码吗?因为我粘贴了各种代码,所以我确定我做错了什么。

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

2 个答案:

答案 0 :(得分:1)

我认为这是我所能做到的。当然,可以有一些逻辑魔术师来简化它,但是我认为他们可能无法将if逻辑放在一行上!

这只会循环一次,就运行时间而言,这应该是您最大的障碍。我确保指定您在sht2中进行搜索,删除了一些未使用的变量,并确保在子程序末尾重置application设置。除此之外,我唯一要做的就是尽我所能地合并您的if语句,并将它们放入一个循环中。

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

答案 1 :(得分:0)

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

您能不能让我知道最后两个Ifs的区别,因为两个ifs条件的函数都相同。