VBA代码很慢，需要优化

时间：2017-09-25 20:06:00

标签： excel vba excel-vba

任何人都可以帮助优化我的代码而不会崩溃我的Excel吗？ 我把它放到3个不同的宏中，因为它冻结了我的excel。 这主要是使用录音机完成的。

不确定罪魁祸首是vlookups，大数据集还是因为我主要使用了录音机，因此我没有任何捷径。

任何人都可以帮助组合这些代码并使其运行更顺畅吗？

 Sub finalversion1()

''original filter logic

    ActiveSheet.Range("$A$1:$DN$11800").AutoFilter Field:=109, Criteria1:= _
        "=Foreign Exchange Option", Operator:=xlOr, Criteria2:= _
        "=Standalone Cash Ticket Trade"
    Sheets("valumeasure").Select
    ActiveSheet.Range("$A$1:$AB$8134").AutoFilter Field:=9, Operator:= _
        xlFilterValues, Criteria2:=Array(0, "10/31/2040", 0, "12/3/2035", 0, "10/6/2034", 0 _
        , "6/24/2033", 0, "12/29/2032", 0, "6/23/2031", 0, "11/25/2030", 0, "10/9/2029", 0, _
        "11/1/2028", 0, "12/21/2027", 0, "8/31/2026", 0, "11/19/2025", 0, "11/29/2024", 0, _
        "11/14/2023", 0, "12/28/2022", 0, "11/17/2021", 0, "12/14/2020", 0, "12/30/2019", 0, _
        "12/31/2018", 2, "5/17/2017", 2, "5/18/2017", 2, "5/19/2017", 2, "5/22/2017", 2, _
        "5/23/2017", 2, "5/24/2017", 2, "5/25/2017", 2, "5/26/2017", 2, "5/30/2017", 2, _
        "5/31/2017", 1, "6/30/2017", 1, "7/31/2017", 1, "8/30/2017", 1, "9/29/2017", 1, _
        "10/31/2017", 1, "11/30/2017", 1, "12/29/2017")

        End Sub


 Sub finalversion2()

'' vlookup file

    Worksheets("valumeasure").Columns(3).Copy Destination:=Sheets("File").Columns(1)  ''copy and paste filtered values from valuation measure file
    Worksheets("eodcpos").Columns(2).Copy Destination:=Sheets("File").Columns(2)  ''copy and paste filtered values eodc

   ''Looking up into eodc position file
    Worksheets("File").Activate

    Range("C2").Select
    ActiveCell = "=VLOOKUP(A2,B:B,1,FALSE)"
    Selection.AutoFill Destination:=Range("C2:C8278")




    ''starting here we bring in eodc data
    Range("D2").Select
    ActiveCell = "=VLOOKUP(C2,eodcpos!B:BK,62,FALSE)"
    Selection.AutoFill Destination:=Range("D2:D8278")
    Range("E2").Select
    ActiveCell = "=VLOOKUP(C2,eodcpos!B:BK,17,FALSE)"
    Selection.AutoFill Destination:=Range("E2:E8278")
    Range("F2").Select
    ActiveCell = "=VLOOKUP(C2,eodcpos!B:BK,27,FALSE)"
    Selection.AutoFill Destination:=Range("F2:F8278")
    Range("G2").Select
    ActiveCell = "=VLOOKUP(C2,eodcpos!B:BK,57,FALSE)"
    Selection.AutoFill Destination:=Range("G2:G8278")
    Range("H2").Select
    ActiveCell = "=VLOOKUP(C2,eodcpos!B:DE,108,FALSE)"
    Selection.AutoFill Destination:=Range("H2:H8278")

    ''now looking up into valuation measure file.

        Range("I2").Select
    ActiveCell = "=VLOOKUP(C2,valumeasure!C:U,7,FALSE)"
    Selection.AutoFill Destination:=Range("I2:I8278")

        Range("J2").Select
    ActiveCell = "=VLOOKUP(C2,valumeasure!C:U,3,FALSE)"
    Selection.AutoFill Destination:=Range("J2:J8278")

     Range("K2").Select
    ActiveCell = "=VLOOKUP(C2,valumeasure!C:U,19,FALSE)"
    Selection.AutoFill Destination:=Range("K2:K8278")

        Range("L2").Select
    ActiveCell = "=VLOOKUP(C2,valumeasure!C:U,8,FALSE)"
    Selection.AutoFill Destination:=Range("L2:L8278")

    ''headers

              End Sub



      Sub finanlversion4()



Dim rng As Range

''sample file creation
Worksheets("Sample File").Activate




''values


    Dim src As Range
    Set src = Worksheets("File").Range("2:8278")

    Dim dst As Range
    Set dst = Worksheets("Sample File").Range("3:8279")

    ' sample file creation
    ' values

    dst.Columns("A") = "CSH"   ' hardcode
    dst.Columns("D") = "1"
    dst.Columns("G") = "USD"
    dst.Columns("J") = "DEALT"
    dst.Columns("N") = "0"

    dst.Columns("B") = src.Columns("D").Value
    dst.Columns("C") = src.Columns("E").Value
    dst.Columns("E") = src.Columns("F").Value
    dst.Columns("F") = src.Columns("F").Value
    dst.Columns("H") = src.Columns("L").Value
    dst.Columns("I") = src.Columns("G").Value
    dst.Columns("M") = src.Columns("I").Value
    dst.Columns("O") = src.Columns("K").Value

    dst.Columns("P") = "=IF(RC[-1]<0,""Y"",""N"")"



End Sub

2 个答案:

答案 0 :(得分：4)

仅举几例。

多次查找与一次

您正在多次查找C2（使用VLOOKUP）。您可以使用MATCH()函数将此选项替换为 ONE lookup ，并使用INDEX来检索该值。
注意：另外，如果可以，请考虑使用近似匹配。这样只能在干净的分类数据上完成，但速度更快。

复制整列

考虑仅复制带有数据的范围，而不是整列。

Application.Calculation / Screenupdating

作为Mat's Mug correctly pointed out，你还应该考虑关闭一些excel应用程序设置，同时运行代码，并在最后重新打开它们，做他们只做ONCE的事情。
Application.ScreenUpdating Property
Application.Calculation Property

答案 1 :(得分：1)

我将在稍后查看是否可以查看剩余代码，但尝试让Excel设置范围，并避免在更改工作簿时使用.Select。这是未经测试的。

Sub SpeedUpCode(ByVal Value As Boolean)
    If Value = True Then
        With Application
            .ScreenUpdating = False
            .Calculation = xlCalculationManual
        End With
    ElseIf Value = False Then
        With Application
            .ScreenUpdating = True
            .Calculation = xlCalculationAutomatic
        End With
    End If
End Sub

Sub finalversion1()

    ''original filter logic

    Call SpeedUpCode(True)

    Dim Rng1 As Range, Rng2 As Range
    Dim ws1 As Worksheet, ws2 As Worksheet

    Set ws1 = ThisWorkbook.Sheets(1)    'Not sure of your sheet
    Set ws2 = ThisWorkbook.Sheets("valumeasure")
    Set Rng1 = ws1.UsedRange
    Set Rng2 = ws2.UsedRange

    Rng1.AutoFilter Field:=109, Criteria1:= _
        "=Foreign Exchange Option", Operator:=xlOr, Criteria2:= _
        "=Standalone Cash Ticket Trade"
    Rng2.AutoFilter Field:=9, Operator:= _
        xlFilterValues, Criteria2:=Array(0, "10/31/2040", 0, "12/3/2035", 0, "10/6/2034", 0 _
        , "6/24/2033", 0, "12/29/2032", 0, "6/23/2031", 0, "11/25/2030", 0, "10/9/2029", 0, _
        "11/1/2028", 0, "12/21/2027", 0, "8/31/2026", 0, "11/19/2025", 0, "11/29/2024", 0, _
        "11/14/2023", 0, "12/28/2022", 0, "11/17/2021", 0, "12/14/2020", 0, "12/30/2019", 0, _
        "12/31/2018", 2, "5/17/2017", 2, "5/18/2017", 2, "5/19/2017", 2, "5/22/2017", 2, _
        "5/23/2017", 2, "5/24/2017", 2, "5/25/2017", 2, "5/26/2017", 2, "5/30/2017", 2, _
        "5/31/2017", 1, "6/30/2017", 1, "7/31/2017", 1, "8/30/2017", 1, "9/29/2017", 1, _
        "10/31/2017", 1, "11/30/2017", 1, "12/29/2017")

    Call SpeedUpCode(False)

End Sub
相关问题
最新问题