Vba sneller maken

[amateur1902]

Hallo,

Weet iemand misschien of het mogelijk is om je vba codes sneller te laten lopen via wat extra code's.

Alvast bedankt

 

[Haaren101]

Welke VBA? Excel, Word?

Ron

 

[amateur1902]

Het is in vba Excel. De code waarover ik het heb is hieronder geplaatst. Heb met veel moeite hem in elkaar gekregen maar hij is nog een beetje traag. Vraag me dan dus ook af of hij ook sneller gemaakt kan worden.

Private Sub CommandButton1_Click()

'script weergave
Application.ScreenUpdating = False
    
'### START
sngStart = Timer                               ' Get start time.

Set objDataControl = New BlpData

' Set up the fields in an array
arrayFields = Array("PX_LAST")

' Set up the securities in an array
Range("b19").Select
Range(Selection, Selection.End(xlDown)).Select
nr_comp = Selection.Rows.Count

Dim arraySecurities() As String
ReDim arraySecurities(nr_comp)

Range("c15").Select
arraySecurities(0) = ActiveCell.Value

Range("b19").Select
i = 1
Do While i <= nr_comp
    arraySecurities(i) = ActiveCell.Value
    ActiveCell.Offset(1, 0).Select
    i = i + 1
Loop

' Set the periodicity to daily
objDataControl.Periodicity = bbDaily

' Make the request from date to date
    startd = Range("e4").Value
    endd = Range("e5").Value

'#### Bloomberg Connection ####
    objDataControl.GetHistoricalData arraySecurities, 1, arrayFields, _
    CDate(startd), _
    CDate(endd), _
    Results:=vtResult

'count the nr of dates
nr_of_dates = UBound(vtResult)

'arrange independent array
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

'start loop, calc correl, put in excel

Dim arr_Dp() As Variant
ReDim arr_Dp(nr_of_dates)

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)
        'Range("C18").Offset(a, 0).Value = Application.Correl(arr_Id, arr_Dp)
        
        ReDim arr_Dp(nr_of_dates) As Variant
Next

'empty the area
    Range("E20").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents

'Place data in table
nrCompz = UBound(arraySecurities)
corr = Range("G7").Value
For k = 1 To nrCompz

 If (arrayCorrel(k) = "1") Then
 ElseIf (arrayCorrel(k) > corr) Then
    Range("E20").Offset(k, 0).Value = arraySecurities(k)
    Range("G20").Offset(k, 0).Value = arrayCorrel(k)
 End If

Next


'sort the correl data
    Range("E20").Select
    Range(Selection, Range("G10000")).Select
    Selection.Sort Key1:=Range("G20"), Order1:=xlDescending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("A1").Select


'### END
sngEnd = Timer                                 ' Get end time.
sngElapsed = Format(sngEnd - sngStart, "Fixed") ' Elapsed time.

'Set m_BlpData = Nothing
Call objDataControl.Flush
    
' message
    MsgBox sngElapsed & " seconds)"


End Sub

 

[Haaren101]

Hallo Amateur,

Ik probeer zelf altijd de SELECT statements te vermijden

Ik lees altijd eerst de data van het sheet in in het geheugen door de gegevens in arrays te plaatsen en dan alle code op de arrays te laten werken.

Ik kan helaas niet goed beoordelen of dat voor dit stukje code ook opgaat

Ron (ook amateur)

 

[Wigi]

bvb

Dit

'sort the correl data
    Range("E20").Select
    Range(Selection, Range("G10000")).Select
    Selection.Sort Key1:=Range("G20"), Order1:=xlDescending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("A1").Select

wordt

'sort the correl data
    Range("E20:G10000").Sort _
        Key1:=Range("G20"), Order1:=xlDescending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

Hier bvb:

Range("b19").Select
i = 1
Do While i <= nr_comp
    arraySecurities(i) = ActiveCell.Value
    ActiveCell.Offset(1, 0)[B].Select[/B]
    i = i + 1
Loop

ben je veel te veel aan het selecteren (afhankelijk van het aantal rijen), en ook die lus is niet nodig.

Wigi

 

[amateur1902]

Het is onderhand weer een erg lange formule geworden

Maar het verwijderen van selects doen inderdaad wonderen voor het systeem.

Allemaal bedankt.