Code is te langzaam

Status
Niet open voor verdere reacties.
V

VBAn00b

Gebruiker
Lid geworden
22 feb 2008
Berichten
17
Beste forumleden,

Wij zijn al enige tijd bezig met het bouwen van een Excelprogramma dat de correlatie tussen verschillende fondsen moet weer gaan geven. In principe zijn we (voor ons gevoel) bijna klaar. Gezegd moet worden dat we met min of meer 0 kennis van VBA zijn begonnen en mede dankzij fora zoals deze, vooruit zijn geholpen.

We zijn nogsteeds aan het debuggen maar zijn nu op een punt aangeland waarop we zelf niet verder meer kunnen. We zijn best tevreden over de code maar het kan goed zijn dat er 'domme' fouten in zitten. Ook is de code niet zo snel, dit moet sneller kunnen we weten zelf alleen niet hoe!

Ons verzoek is of iemand eens naar onze code zou willen kijken en een paar tips willen geven of wijzigingen willen maken, zodat het eindresultaat goed, snel en stabiel is!

Code: 
im objDataControl As BLP_DATA_CTRLLib.BlpData

Private Sub CommandButton1_Click()

    Set objDataControl = New BlpData
    Call objDataControl.Flush
    
     'Script weergave uit (niet zichtbaar voor gebruiker)
    Application.ScreenUpdating = False
    'Application.Calculation = xlCalculationManual
     
     '### START
    sngStart = Timer
         
    'Legen van cellen in Excel
    Dim rng As Range
    Set rng = Range("D18:R1000")
    Range(rng, rng).ClearContents
    
    'Opzetten van velden voor array
    arrayFields = Array("PX_LAST")
     
     ' Tickers tellen
    nr_comp = Range(Range("B18"), Range("B18").End(xlDown)).Rows.Count
    
    'Bepaald grote van array
    Dim arraySecurities() As String
    ReDim arraySecurities(nr_comp)
    
    'Leading Fund
    arraySecurities(0) = Range("B10").Value
   ' Range("D18").FormulaR1C1 = "=R[-8]C[-2]"
    
    'Peers (per peer wordt data binnen gehaald)
    With Range("B18")
        i = 1
        Do While i <= nr_comp
            arraySecurities(i) = .Cells(i, 1).Value
            i = i + 1
        Loop
    End With
     
     ' Berekening op basis van dagelijkse koersen
    objDataControl.Periodicity = bbDaily
     
     ' Bepaling data (data uit welke periode)
    startd = Range("D4").Value
    endd = Range("D5").Value
    
    'plaatsen data in excel
    Range("L15").ClearContents
    Range("N15").ClearContents
    
    Range("D5").Select
    Application.CutCopyMode = False
    Selection.Copy
    
    Range("N15").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Range("D4").Select
    Application.CutCopyMode = False
    Selection.Copy
    
    Range("L15").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    
    'Instellen datum
    Range("D4").Select
    ActiveCell.FormulaR1C1 = _
        "=DATE(  YEAR(  NOW()  )-R[1]C[3],   MONTH(  NOW()  )-RC[3],  DAY(  NOW()  )-R[-1]C[3]   )"
    
    Range("D5").Select
    ActiveCell.FormulaR1C1 = "=TODAY()"
     
     '#### Bloomberg Connection ####
    objDataControl.GetHistoricalData arraySecurities, 1, arrayFields, _
    CDate(startd), _
    CDate(endd), _
    Results:=vtResult

    
     'Tel het aantal data
    nr_of_dates = UBound(vtResult)
     
     'Maak van multi dimentional array een single array (onafhankelijk)
    Dim arr_Id() As Variant
    ReDim arr_Id(nr_of_dates)
    For z = 0 To nr_of_dates
        arr_Id(z) = vtResult(z, 0, 1)
    Next
    
     'Opstellen array voor afhankelijke fondsen
    Dim arr_Dp() As Variant
    ReDim arr_Dp(nr_of_dates)
    
    'Berekening van correlatie
    Dim arrayCorrel() As Variant
    ReDim arrayCorrel(nr_comp)
    
    For a = 0 To nr_comp
        For b = 0 To nr_of_dates
            arr_Dp(b) = vtResult(b, a, 1)
        Next
         
        arrayCorrel(a) = Application.Correl(arr_Id, arr_Dp)
        
        u = a - 1
        
        If Not IsNumeric(arrayCorrel(a)) Then
            arrayCorrel(a) = arrayCorrel(u)
        End If
        
          
        ReDim arr_Dp(nr_of_dates) As Variant
    
    Next
     
     'Filter voor correlaties, niet groter dan 1 of kleiner dan ingestelde parameter
    nrCompz = UBound(arraySecurities)
    corr = Range("D8").Value
    For k = 1 To nrCompz
        'If IsNumeric(arrayCorrel(k)) Then
            If arrayCorrel(k) <> "1" And arrayCorrel(k) > corr Then
                Range("D18").Offset(k, 0).Value = arraySecurities(k)
                Range("H18").Offset(k, 0).Value = arrayCorrel(k)
            End If
        'End If
    Next k

     'Correlatiecoëfficiënt sorteren en invoegen in Excel
    Set rng = Range("D19")
    Range(rng, Range("H10000")).Sort Key1:=Range("H19"), Order1:=xlDescending, _
    Header:=xlNo, _
    OrderCustom:=1, _
    MatchCase:=False, _
    Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal

'Vul formules in Excel

Range("D18").Select
ActiveCell.FormulaR1C1 = "=R[-8]C[-2]"
Range("D18").Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.CutCopyMode = False
    

    Range("H18").Select
    ActiveCell.FormulaR1C1 = "-"
    

nr_corr = Range(Range("D18"), Range("D18").End(xlDown)).Rows.Count + 17

Range("F18:F" & nr_corr).FormulaR1C1 = "=Proper(BDP(RC[-2]&"" equity"",""name""))"

Range("N18:N" & nr_corr).FormulaR1C1 = "=BDP(RC[-10]&"" equity"",""VOLUME_AVG_30D"")"

Range("P18:P" & nr_corr).FormulaR1C1 = "=BDP(RC[-12]&"" equity"",""last price"")"

Range("R18:R" & nr_corr).FormulaR1C1 = "=(RC[-2]/BDP(RC[-14]&"" equity"",""PX_CLOSE_1D""))-1"

Range("J19:J" & nr_corr).FormulaR1C1 = "=SUMPRODUCT((Data!R2C1:R2000C1=Interface!R18C6)*(Data!R2C3:R2000C3=Interface!R[0]C6)*(Data!R2C4:R2000C4=Data!R1C8)*(Data!R2C6:R2000C6))/SUMPRODUCT((Data!R2C1:R2000C1=Interface!R18C6)*(Data!R2C3:R2000C3=Interface!R[0]C6)*(Data!R2C4:R2000C4=Data!R1C8))"
    
Range("L19:L" & nr_corr).FormulaR1C1 = "=SUMPRODUCT((Data!R2C1:R2000C1=Interface!R18C6)*(Data!R2C3:R2000C3=Interface!R[0]C6)*(Data!R2C4:R2000C4=Data!R1C8)*(Data!R2C7:R2000C7))/SUMPRODUCT((Data!R2C1:R2000C1=Interface!R18C6)*(Data!R2C3:R2000C3=Interface!R[0]C6)*(Data!R2C4:R2000C4=Data!R1C8))"


     
     'Filteren benamingen
    Range("D18:D1149").Replace What:=" Equity", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    
    Range("D18:D1149").Replace What:="Equity", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    
    Range("D18:D1149").Replace What:=" EQUITY", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    
    Range("D18:D1149").Replace What:="EQUITY", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    
    Range("D18:D1149").Replace What:=" equity", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    
    Range("D18:D1149").Replace What:="equity", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    
    Range("D18:D1149").Replace What:="  ", Replacement:=" ", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    
    Range("D18:D1149").Replace What:="   ", Replacement:=" ", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    
    Range("D18:D1149").Replace What:="    ", Replacement:=" ", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    
    Range("D18:D1149").Replace What:="     ", Replacement:=" ", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    
    Range("D18:D1149").Replace What:="      ", Replacement:=" ", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    
    Range("D18:D1149").Replace What:="       ", Replacement:=" ", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False


        
'##########
            
'default variabelen tijdsduur

Range("G3").Select
ActiveCell.FormulaR1C1 = "5"

Range("G4").Select
ActiveCell.FormulaR1C1 = "0"
    
Range("G5").Select
ActiveCell.FormulaR1C1 = "0"

Range("A1").Select

'Default variabel correlatie
Range("D8").Select
ActiveCell.FormulaR1C1 = "0.60"


'recalculate
    Application.Calculation = xlAutomatic
    
'replace
    Range("J18:J1000").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Range("L18:L1000").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Application.CutCopyMode = False
    
'Velden zonder weergave geven - aan
    Range("J18:J1000").Replace What:="#DIV/0!", Replacement:="-", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
    
    Range("L18:L1000").Replace What:="#DIV/0!", Replacement:="-", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
        
    Range("A1").Select

     '### Stop Timer
    sngEnd = Timer
    sngElapsed = Format(sngEnd - sngStart, "Fixed")
            
     'Tijdsmelding aantal seconden proces snelheid
     Range("F8").Value = sngElapsed & " seconden"
     
    With Application
         
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
    
End Sub

' Tickerlijst wissen
Private Sub CommandButton2_Click()

Range("B18").Select

    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    
End Sub

' Koppelen afhankelijk fonds uit drop down menu met onafhankelijk fonds, weergeven in Bloomberg
Private Sub CommandButton3_Click()

    blp = DDEInitiate("winblp", "bbk")

a = Range("D18").Value
k = Range("C16").Value

     Call DDEExecute(blp, "<blp-1>" & "<Cancel>" & a & "<Equity>" & "       " & k & "<equity>" & " " & "HS" & "<GO>")
     'Call DDETerminate(blp)
     
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub

Alvast bedankt voor welke bijdrage dan ook!

VBAn00b
 
Installeer meer geheugen. Excel is een geheugen vreter. Als je data heen en weer copieert gebruik je al gauw erg veel RAM.

Ik zou deze vraag trouwens posten bij VBA en niet VB.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan