VBA代码很慢，需要优化

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

不知道如果罪魁祸首是vlookups，大数据集或只是因为我大多使用logging器，因此我没有任何捷径。

任何人都可以帮助结合这个代码，使其运行更stream畅吗？

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 

Answer 1

仅举几个。

多个查找与一个

您正在查找C2多次（使用VLOOKUP）。 您可以使用MATCH()函数将其replace为一个查找 ，然后使用INDEX检索值。
注意：另外，如果可以，请考虑使用近似匹配 。 这样做只能在干净的sorting数据上完成，而且速度更快。

复制整列

考虑只复制范围与数据，而不是整列。

Application.Calculation / Screenupdating

正如Mat's Mug正确指出的那样 ，在运行代码时 ，还应该考虑closures一些excel应用程序设置，并在最后重新打开它们，以完成他们只做一次的事情。
Application.ScreenUpdating属性
应用程序。计算属性

Answer 2

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

 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