VBA, Optimiere VLookup/Formeln

Question

Ich habe einen Code, weitgehend aus dem Makrorecorder gemacht. Läuft sehr langsam. Ich denke, das liegt an den vlookups oder der Formel, kann jemand helfen, diesen Code schneller zu machen?

Ich habe auch filtern und kopieren und einfügen, Zweifel, die diese verlangsamen. Vielleicht ist es nur, weil es auf einem großen Datensatz verwendet wird. Kann etwas getan werden?

Sub filtering() 
' 


' filtering Macro 
' 



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

    Set ws1 = ThisWorkbook.Sheets("eodcpos") 
    Set ws2 = ThisWorkbook.Sheets("valumeasure3") 
    Set ws3 = ThisWorkbook.Sheets("File") 

    Set ws4 = ThisWorkbook.Sheets.Add 
    ws4.Name = "lookup" 

    Set ws5 = ThisWorkbook.Sheets("Sample File") 

    Set Rng1 = ws1.UsedRange 
    Set Rng2 = ws2.UsedRange 
    Set src = Worksheets("File").Range("2:757") 
    Set src1 = Worksheets("lookup").Range("2:17783") 

' 
    Rng1.AutoFilter Field:=11, Criteria1:= _ 
     "=Traded Position" 

    Rng1.AutoFilter Field:=2, Criteria1:= _ 
     "<>*-C*", Operator:=xlAnd, Criteria2:="<>*-P*" 

    Rng1.AutoFilter Field:=109, Criteria1:=Array _ 
     ("Foreign Exchange Forward", "Foreign Exchange Spot", "Foreign Exchange Swap"), _ 
     Operator:=xlFilterValues 

    Rng1.AutoFilter Field:=33, Criteria1:= _ 
     "<>NA" 

    Rng1.AutoFilter Field:=63, Criteria1:= _ 
     "<>129540", Operator:=xlAnd, Criteria2:="<>135845" 

    Rng2.AutoFilter Field:=5, Criteria1:= _ 
     "=Buy Notional Amount", Operator:=xlOr, Criteria2:="=Sell Notional Amount" 

    '' vlookup file 

     ws4.Activate 

     Range("A1").Value = "val pos id" 
     ws2.Columns(3).Copy Destination:=Sheets("lookup").Columns(1) 
     ws4.Range("A:A").RemoveDuplicates Columns:=Array(1) 

     Range("B1").Value = "eodc pos id" 
     ws1.Columns(2).Copy Destination:=Sheets("lookup").Columns(2) 
     Range("C1").Value = "eodc pos decor id" 
     ws1.Columns(41).Copy Destination:=Sheets("lookup").Columns(3) 

     Range("D1").Value = "pos id lookup" 
     Range("D2").Select 
     ActiveCell = "=VLOOKUP(A2,B:B,1,FALSE)" 
     Selection.AutoFill Destination:=src1.Columns("D") 


     Range("E1").Value = "pos decor id lookup" 
     Range("E2").Select 
     ActiveCell = "=VLOOKUP(fxpd!B2,C:C,1,FALSE)" 
     Selection.AutoFill Destination:=src1.Columns("E") 

     ''Filtering File data 
     ws4.UsedRange.AutoFilter Field:=4, Criteria1:= _ 
     "<>#N/A" 

     ''creating File tab 
     ws4.Columns(4).Copy Destination:=Sheets("File").Columns(1) ''copy and paste filtered values from valuation measure file 
     ws4.Columns(5).Copy Destination:=Sheets("File").Columns(2) ''copy and paste filtered values from fxpd 

     ws3.Activate 


     Range("X2").Select 
     ActiveCell = "=VLOOKUP(A2,eodcpos!B:BP,COLUMNS(B:BP),FALSE)" ''product classification code 
     Selection.AutoFill Destination:=src.Columns("X") 

    '' ActiveCell.FormulaR1C1 = _ 
    '' "=IF(RIGHT(LEFT(RC[20],64),40)=""ProductType:'FXD';ProductSubType:'SWLEG'"",""XSW"",IF(RIGHT(LEFT(RC[20],64),40)=""ProductType:'FXD';ProductSubType:'FXD'"",""FXD"",""NA""))" 
    '' Range("D2").Select 
    '' Selection.AutoFill Destination:=src.Columns("D") 

     Range("D2").Select 
     ActiveCell = "=IF(RIGHT(LEFT(X2,64),40)=""ProductType:'FXD';ProductSubType:'SWLEG'"",""XSW"",IF(RIGHT(LEFT(X2,64),38)=""ProductType:'FXD';ProductSubType:'FXD'"",""FXD"",""NA""))" 
     Selection.AutoFill Destination:=src.Columns("D") 

     Range("E2").Select 
     ActiveCell = "=VLOOKUP(A2,eodcpos!B:BK,62,FALSE)" ''counterparty short name/client id 
     Selection.AutoFill Destination:=src.Columns("E") 
     Range("F2").Select 
     ActiveCell = "=VLOOKUP(A2,eodcpos!B:BK,17,FALSE)" ''source trade id/deal id 
     Selection.AutoFill Destination:=src.Columns("F") 
     Range("G2").Select 
     ActiveCell = "=VLOOKUP(A2,eodcpos!B:BK,27,FALSE)" ''trade date/contract date 
     Selection.AutoFill Destination:=src.Columns("G") 
     Range("H2").Select 
     ActiveCell = "=VLOOKUP(A2,eodcpos!B:V,COLUMNS(B:V),FALSE)" ''settlement date/actual settlement date 
     Selection.AutoFill Destination:=src.Columns("H") 
     Range("I2").Select 
     ActiveCell = "=VLOOKUP(A2,eodcpos!B:BG,COLUMNS(B:BG),FALSE)" ''book runner/source book name 
     Selection.AutoFill Destination:=src.Columns("I") 

''lookup into fxpd now 

      Range("J2").Select 
     ActiveCell = "=VLOOKUP(A2,eodcpos!B:AO,COLUMNS(B:AO),FALSE)" ''pull in pos decorator id 
     Selection.AutoFill Destination:=src.Columns("J") 
      Range("K2").Select 
     ActiveCell = "=VLOOKUP(B2,fxpd!B:U,COLUMNS(B:U),FALSE)" ''spot rate/forward rate 
     Selection.AutoFill Destination:=src.Columns("K") 

     ws3.Columns(12).Copy Destination:=Sheets("File").Columns(11) ''outright rate/forward rate 

      Range("M2").Select 
     ActiveCell = "=VLOOKUP(B2,fxpd!B:I,COLUMNS(B:I),FALSE)" ''buy currency code/buy curency 
     Selection.AutoFill Destination:=src.Columns("M") 
     Range("N2").Select 
     ActiveCell = "=VLOOKUP(B2,fxpd!B:AK,COLUMNS(B:AK),FALSE)" ''sell currency code/sell curency 
     Selection.AutoFill Destination:=src.Columns("N") 




     src.Columns("O") = "LIVE" ''hardcode type name 
     src.Columns("P") = "1" ''hardcode leg number 
     src.Columns("Q") = "S" ''hardcode leg duration code 
     src.Columns("R") = "" ''hardcode option value date 



     Range("S2").Select 
     ActiveCell = "=IF(valumeasure3!E2=""Buy Notional Amount"",VLOOKUP(A2,valumeasure3!C:U, COLUMNS(C:U),FALSE),0)" ''buy currency amt 
     Selection.AutoFill Destination:=src.Columns("S") 


      Range("T2").Select 
     ActiveCell = "=IF(valumeasure3!E2=""Sell Notional Amount"",VLOOKUP(A2,valumeasure3!C:U, COLUMNS(C:U),FALSE),0)" ''sell curency amt 
     Selection.AutoFill Destination:=src.Columns("T") 

      Range("U2").Select 
     ActiveCell = "=VLOOKUP(A2,eodcpos!B:I,8,FALSE)" ''setup for buy risk currency flag 
     Selection.AutoFill Destination:=src.Columns("U") 


      Range("V2").Select 
     ActiveCell = "=IF(U2=""Long"",""B"",""S"")" ''buy risk currency flag 
     Selection.AutoFill Destination:=src.Columns("V") 

     Range("W2").Select 
     ActiveCell = "=IF(S2<>""0"",T2/S2,""0"")" '' 
     Selection.AutoFill Destination:=src.Columns("W") 



''headers 
     Range("C1").Value = "" 
     Range("D1").Value = "Product Family Name" 
      Range("E1").Value = "Client name" 
       Range("F1").Value = "deal ID" 
       Range("G1").Value = "trade Date" 
        Range("H1").Value = "settlement" 
         Range("I1").Value = "source book" 
          Range("J1").Value = "PD ID" 
          Range("K1").Value = "forward rate" 
           Range("L1").Value = "forward rate" 
           Range("M1").Value = "buy currency" 
             Range("N1").Value = "sell currency" 
              Range("O1").Value = "type name" 
               Range("P1").Value = "leg number" 
                Range("Q1").Value = "duration" 
                  Range("R1").Value = "option value date" 
                   Range("S1").Value = "buy ccy amt" 
                     Range("T1").Value = "sell ccy amt" 
                      Range("U1").Value = "N/A" 
                      Range("V1").Value = "buy risk ccy flag" 
                      Range("W1").Value = "sell buy ratio" 



    'headers for Sample Data sheet 
    Range("A1").Value = "Product Family Name" 
    Range("B1").Value = "Client Name" 
     Range("C1").Value = "Deal ID" 
     Range("D1").Value = "Amendment Number" 
      Range("E1").Value = "Trade Date" 
       Range("F1").Value = "Settlement Date" 
       Range("G1").Value = "Book Runner" 
        Range("H1").Value = "Leg Status Type Name" 
         Range("I1").Value = "Leg Number" 
          Range("J1").Value = "Leg Duration Code" 
          Range("K1").Value = "Spot Rate" 
           Range("L1").Value = "Outright Rate" 
           Range("M1").Value = "Buy Currency Code" 
             Range("N1").Value = "Sell Currency Code" 
              Range("O1").Value = "Buy Currency Amt" 
               Range("P1").Value = "Sell Currency Amt" 
                Range("Q1").Value = "Buy Risk Currency Flag" 
                  Range("R1").Value = "Option Value Date" 
                   Range("S1").Value = "Sell Buy Ratio" 
     ' Copying data from File sheet 
     ws3.Columns(4).Copy Destination:=Sheets("Sample File").Columns(1) 
     ws3.Columns(5).Copy Destination:=Sheets("Sample File").Columns(2) 
     ws3.Columns(6).Copy Destination:=Sheets("Sample File").Columns(3) 
     src.Columns("D") = "1" ''hardcode amendment number 
     ws3.Columns(7).Copy Destination:=Sheets("Sample File").Columns(5) 
     ws3.Columns(8).Copy Destination:=Sheets("Sample File").Columns(6) 
     ws3.Columns(9).Copy Destination:=Sheets("Sample File").Columns(7) 
     src.Columns("H") = "LIVE" ''hardcode type name 
     src.Columns("I") = "1" ''hardcode leg number 
     src.Columns("J") = "S" ''hardcode leg duration code 
     ws3.Columns(11).Copy Destination:=Sheets("Sample File").Columns(11) 
     ws3.Columns(11).Copy Destination:=Sheets("Sample File").Columns(12) 
     ws3.Columns(13).Copy Destination:=Sheets("Sample File").Columns(13) 
     ws3.Columns(14).Copy Destination:=Sheets("Sample File").Columns(14) 
     ws3.Columns(19).Copy Destination:=Sheets("Sample File").Columns(15) 
     ws3.Columns(20).Copy Destination:=Sheets("Sample File").Columns(16) 
     ws3.Columns(21).Copy Destination:=Sheets("Sample File").Columns(17) 
     src.Columns("R") = "" ''hardcode option value date 
     ws3.Columns(22).Copy Destination:=Sheets("Sample File").Columns(19) 

    End Sub 

Answer 1

Sie können versuchen, die Bildschirmaktualisierung am Anfang des Codes zu deaktivieren. Application.ScreenUpdating = False

Denken Sie daran, es am Ende des Codes wieder einzuschalten. Application.ScreenUpdating = True

Answer 2

Was die Geschwindigkeit, können Sie die folgenden zu Beginn des Teil verwenden:

With Application 
    .ScreenUpdating = False 
    .DisplayAlerts = False 
End With 

und diese wiederherstellen, am Ende des Unter

With Application 
    .ScreenUpdating = True 
    .DisplayAlerts = True 
End With 

Die Haupt-rote Flagge mit diesem Code ist jedoch, dass es unglaublich spröde ist. Zeilen- und Spaltenausdehnungen und -referenzen sind im gesamten Subsystem fest codiert, die geringste Änderung führt dazu, dass die Dinge umfallen.

Zusätzlich kopieren Sie ganze Spalten. Sie können die Kopie auf den Umfang der Daten beschränken und potenziell zusammenhängende Kopien zu einzelnen Transaktionen kombinieren.

Answer 3

Nicht Select Zellen!

Range("D2").Select 
    ActiveCell = whatever 
    Selection.AutoFill Destination:=src.Columns("D") 

Sollte

With Range("D2") 
    .formula = whatever 
    .autofill Destination := src.columns(4) 
end with 

Answer 4

Mit all diesen VLookup Gleichungen Sie wahrscheinlich Application.Calculation = xlCalculationManual ganz am Anfang des Makros mit Dinge beschleunigen werde, während Sie Ihre Berechnung zurück zu Application.Calculation = xlCalculationAutomatic wenn Ihr Makro gesetzt sollte beendet, und vielleicht Fehlerbehandlung verwenden, um sicherzustellen, dass dies passiert, wie hier diskutiert: https://stackoverflow.com/a/31923310/3546415

Sie auch AutoFilling ganze Spalten. Das ist wahrscheinlich nicht das was du willst und es wird dich wirklich verlangsamen.

Sie werden die Dinge beschleunigen, wenn Sie Ihre automatischen Füllen auf einen begrenzten Bereich wie folgt begrenzen, wo automatischen Füllen in Zeile hält 99 ...

Range("E2").AutoFill Destination:=Range("E2:E99") 

Und Ihre VLookups könnte verbessert werden, wenn man sie auf bestimmte begrenzen dies reicht wie diese eodcpos!$B$1:$BK$9 anstatt ganze Spalten wie eodcpos!B:BK ...

Range("E2") = "=VLOOKUP(A2,eodcpos!$B$1:$BK$99,62,FALSE)" 

Es könnte aber auch Application.ScreenUpdating = False auch tun. Und Sie können wahrscheinlich ein paar Sekunden mit anderen general improvements rasieren, die ziemlich einfach zu finden sind, wenn Sie Google VBA-Optimierung oder so.

Darüber hinaus haben Sie eine Menge Code und wahrscheinlich viel Platz für Verbesserungen. Wie du schon sagtest, kann es sein, dass du wegen der eigentlichen Tabelle langsam bist.

Wenn Sie immer noch Probleme haben. Ich würde vorschlagen, durch den Code zu gehen und die Zeit an verschiedenen Stellen wie diese Berichterstattung ...

Debug.Print Now & "Say what the code just did here" 

können Sie dann grenzen Sie Ihre langsamen Abschnitte auf bestimmte Aktionen nach unten und das konzentrieren, was Sie die meiste Zeit ist kostet.

Ich stelle mir vor, es ist das Autofüllen und Neuberechnen all dieser VLookups. VLookup wird die Dinge wirklich verlangsamen, wenn es ausgiebig genutzt wird. Wenn die Langsamkeit immer noch ein zu großes Problem ist, selbst wenn sie nicht automatisch neu berechnet wird, dann bedenken Sie, wie Sie die Tabelle und/oder VBA so umgestalten, dass VLookups weniger verwendet werden.