VBA voor sneller updaten grafiek

[Revolutionary]

Goedemiddag helpers,

Achtergrondinformatie:
Ik ben al een tijdje bezig met het ontwikkelen van een Monte Carlo Simulatie (MCS) in Excel. Mijn excelbestand voert 5000 simulaties, waarbij iedere simulatie 500 keer ad random een getal kiest uit een reeks van 30 getallen. In totaal gaat het dus om 2,5miljoen berekeningen. Vervolgens wordt in een ander tabblad van deze 5000 simulaties het eindkapitaal berekend (dus dat zijn nog eens 2,5 miljoen berekeningen). De waarden staan in de cellen A2:SF5001.

Het eindkapitaal van de simulaties geef ik vervolgens weer in een grafiek, maar omdat 5.000 lijntjes in een grafiek wat onoverzichtelijk wordt heb ik er voor gekozen om 7 lijntjes met eindkapitaal in de grafiek op te nemen. In de grafiek worden de volgende lijnen getoond: hoogste eindkapitaal, hoogste 1%, hoogste 10%, mediaan, laagste 10%, laagste 1% en laagste eindkapitaal. Ik heb een printscreen toegevoegd om mn verhaal over de grafieklijnen te verduidelijken. Zie

Met behulp van VBA sorteer ik het eindkapitaal van hoog naar laag en vervolgens worden daar de 7 regels uitgehaald die ik hiervoor beschreef. Met behulp van sorteren is het vrij eenvoudig om bijvoorbeeld het hoogste eindkapitaal te vinden. Maar het proces van sorteren duurt vrij lang, dus ik vroeg mij af of het mogelijk is om de VBA-code te laten zoeken naar het hoogste eindkapitaal en de andere 6 lijnen en deze vervolgens in een grafiek weer te geven?

Mijn VBA-code ziet er nu als volgt uit:

Sub Macro_EQ_5000sim()

With Application
    .ScreenUpdating = False
    .EnableEvents = False

'Van hoog naar laag sorteren
    Sheets("MCS Equity").Select    
    Columns("SF:SF").Select
    ActiveWorkbook.Worksheets("MCS Equity").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("MCS Equity").Sort.SortFields.Add Key:=Range("SF2") _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("MCS Equity").Sort
        .SetRange Range("A2:SF5001")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
'Update grafiek
    Sheets("Output").Select
    ActiveSheet.ChartObjects("Grafiek 5").Activate
'De volgende regel zoekt de juiste eindkapitalen op en geeft ze weer in de grafiek
    ActiveChart.SetSourceData Source:=Sheets("MCS Equity").Range("5001:5001,4951:4951,4501:4501,2501:2501,501:501,51:51,2:2")
    ActiveChart.PlotArea.Select
    ActiveChart.SeriesCollection(1).Name = "=""Max"""
    ActiveChart.SeriesCollection(2).Name = "=""Max 1%"""
    ActiveChart.SeriesCollection(3).Name = "=""Max 10%"""
    ActiveChart.SeriesCollection(4).Name = "=""Median"""
    ActiveChart.SeriesCollection(5).Name = "=""Min 10%"""
    ActiveChart.SeriesCollection(6).Name = "=""Min 1%"""
    ActiveChart.SeriesCollection(7).Name = "=""Min"""
    ActiveChart.ChartTitle.Text = "Gesimuleerde equitylijnen" & Chr(13) & "5.000 Sims"
    
    Range("A2").Select

    .ScreenUpdating = True
    .EnableEvents = True
End With
End Sub

Ik verwacht dat de macro een stuk sneller wordt als ik het commando voor sorteren eruit kan halen, maar ik heb te weinig verstand van VBA om zelf een dergelijke code te maken.

Lang verhaal deze keer, maar ik hoop dat iemand kan helpen. Alvast bedankt!

Tim

 

[Revolutionary]

Ik heb nog even over mn eigen vraagstuk nagedacht en ik weet misschien hoe VBA bepaalde regels met eindkapitaal kan opzoeken. Met de volgende formules kunnen de verschillende eindkapitalen berekend worden:

De hoogste 1%:
=GROOTSTE(MCS Equity!SF:SF;(AANTAL(MCS Equity!SF:SF))*1%)

De hoogste 10%:
=GROOTSTE(MCS Equity!SF:SF;(AANTAL(MCS Equity!SF:SF))*10%)

De laagste 1%:
=KLEINSTE(MCS Equity!SF:SF;(AANTAL(MCS Equity!SF:SF))*1%)

De laagste 10%:
=KLEINSTE(MCS Equity!SF:SF;(AANTAL(MCS Equity!SF:SF))*10%)

Het hoogste, laagste en middelste eindkapitaal kan berekend worden met de functies MAX, MIN en MEDIAAN.

Vervolgens kan met verticaal zoeken op kolom SF gezocht worden in welke regels deze 7 waarden staan. Deze rijen moeten dan vervolgens ingevuld worden in de Range bij de grafiek.

Weet iemand hoe ik dat moet vertalen naar een VBA-code?

 

[cow18]

alleen al naar de grafiek kijkend, vermoed ik denkfouten in je werkblad. Het verloop van min en min1% die mogen elkaar na de start eigenlijk nooit meer kruisen. Hetzelfde geldt voor je mediaal-lijn, die voldoet volgens mij ook niet. Hoe je gegevens eruit zien weet ik niet, maar dat sorteren lijkt me verdacht.

even iets verder nagedacht, volgens mij moet je deze formules bv in A5010 en volgende neerzetten en dan doorkopieren tot kolom SF
=MIN($A$2:$A$5001)
=KLEINSTE($A$2:$A$5001;5)
=KLEINSTE($A$2:$A$5001;50)
=MEDIAAN($A$2:$A$5001)
=GROOTSTE($A$2:$A$5001;50)
=GROOTSTE($A$2:$A$5001;5)
=MAX($A$2:$A$5001)
die leveren volgens mij de juiste grafieken op
Sorteren is niet meer nodig

 

[Revolutionary]

Beste cow18,

Nee, ik ben er bijna zeker van dat de grafiek klopt en er ook geen denkfout is gemaakt.

Alle lijntjes stellen simulaties voor van hoe kapitaal zou kunnen bewegen, het kan gebeuren dat het lijntje van -10% op een gegeven moment boven het lijntje komt van +10%, het gaat er namelijk niet zo zeer om wat er is de tussentijd is gebeurd, maar waar het lijntje eindigt.

Het zit ongeveer zo:
In tabblad1 heb ik een reeks van 30 resultaten staan. Deze resultaten zitten grofweg tussen -1% en +3%. Vervolgens wordt in tabblad3 in 5000 regels de verloop van het kapitaal berekend over 500 kolommen door steeds het kapitaal uit de vorige cel te vermenigvuldigen met een van de 30 resulaten die ad random wordt gekozen uit tabblad1.

De simulatie van lijntje -10% kan bijvoorbeeld zijn:
+2%, +1%, -1%, -1%, -1%, -1%, -1%, -1%, -1%, -1% = -4% (even geen rekening gehouden met compounding effects)

De simulatie van lijntje +10% kan bijvoorbeeld zijn:
-1%, -1%, -1%, +1%, +2%, +1%, +1%, +1%, +1%, +2% = +6%

En als je bovenstaande reeks in een grafiek zet zal je zien dat het lijntje van -10% aan het begin boven het lijntje van +10% komt.

Ik hoop dat mn verhaal zo duidelijker is en anders hoor ik het graag. Ik kan eventueel ook een klein voorbeeld bestandje plaatsen, om bovenstaand verhaal te verduidelijken.

Groeten,
Tim

 

[Revolutionary]

Beste cow18,

Ik zie net dat je je vorige reactie hebt aangevuld terwijl ik ook bezig was om te reageren

Ik ben bang dat dat niet een juiste werkwijze zou zijn, aangezien ik dan de simulaties als het ware op knip. Want met jouw formules haal ik uit iedere simulatie bepaalde waarden en deze plak ik aan elkaar en dat is niet de bedoeling.

Tim

 

[cow18]

dit heb ik niet kunnen testen wegens gebrek aan voorbeeldje, dus misschien meot je hier en daar nog iets aanpassen

een macro die de zoveelste rij in rangorde zoekt en daar een string van maakt

Public Rijen   As String 'deze moet bovenin de module staan

Sub ZoekRijen()
  Dim nr As Variant, lRij As Long, Getal As Double
  On Error GoTo fout
  With Sheets("MCS Equity")
    Rijen = ""
    For Each nr In Array(1, 5, 50, 2500, 4951, 4996, 5000)
      lRij = WorksheetFunction.Match(WorksheetFunction.Small(.Range("SF2:SF5001"), nr), .Columns("SF"), 0)
      Rijen = Rijen & "," & lRij & ":" & lRij
    Next
    Rijen = Mid(Rijen, 2, Len(Rijen) - 1)
  End With
  Exit Sub
fout:
  Rijen = "": MsgBox "er is iets fout gegaan"
End Sub

dan moet je bovenstaande macro aanroepen in je andere macro en de string verder gebruiken

 Sheets("Output").Select
      ActiveSheet.ChartObjects("Grafiek 5").Activate
      'De volgende regel zoekt de juiste eindkapitalen op en geeft ze weer in de grafiek
      [COLOR="red"]ZoekRijen[/COLOR]   
   ActiveChart.SetSourceData Source:=Sheets("MCS Equity").Range([COLOR="red"]Rijen[/COLOR])

 

[Revolutionary]

Bedankt cow18:thumb:

Ik ga je code morgen uitproberen, want ik ga nu afsluiten.

Fijne avond!

Tim

 

[Revolutionary]

Het werkt:d

Het update van de grafiek gaat nu echt een stuk sneller

Ik heb geprobeerd om nog 2 zaken aan te passen, maar het is me niet gelukt Het gaat om de volgende 2 zaken:

1. Naast de 5000 simulaties op reeksen van 500, wil ik ook 5000 simulaties doen op reeksen van 300 (dus A:KN). Ik heb jouw code gekopieerd en geprobeerd iets aan te passen zodat wordt gesorteerd op kolom KN, maar in de grafiek worden toch de lijnen getoond van de data t/m kolom SF. Ik weet dat ik dit kan oplossen door de data te verwijderen tussen kolom KN en SF, maar daardoor duurt het uitvoeren van de macro een stuk langer...

Sub ZoekRijen[COLOR="red"]2[/COLOR]()
  Dim nr As Variant, lRij As Long, Getal As Double
  On Error GoTo fout
  With Sheets("MCS Equity")
    Rijen = ""
    For Each nr In Array(1, 5, 50, 2500, 4951, 4996, 5000)
      lRij = WorksheetFunction.Match(WorksheetFunction.Small(.Range("[COLOR="red"]KN2:KN5001[/COLOR]"), nr), .Columns("[COLOR="red"]KN[/COLOR]"), 0)
      Rijen = Rijen & "," & lRij & ":" & lRij
    Next
    Rijen = Mid(Rijen, 2, Len(Rijen) - 1)
  End With
  Exit Sub
fout:
  Rijen = "": MsgBox "er is iets fout gegaan"
End Sub

Kan bovenstaande code aangepast worden zodat de grafiek alleen de lijnen toont van de data in kolom A t/m KN?

2. Bij iedere simulatie veranderd de kleur van de lijnen, waardoor de legenda van de grafiek niet meer klopt. Met andere woorden, de donker blauwe lijn hoort bij het hoogste eindkapitaal, maar bij een volgende simulatie wordt het hoogste eindkapitaal weergegeven door een rode lijn, waardoor de legenda dus niet meer klopt. Is er een manier om de lijn van het hoogste eindkapitaal altijd te koppelen aan dezelfde kleur?

Ik zal zo ook even een voorbeeld bestandje proberen te posten.

Tim

 

[Revolutionary]

Hierbij een voorbeeld bestandje: Bekijk bijlage Voorbeeld MCS.zip

Alvast bedankt voor alle hulp

 

[cow18]

onderstaand is volledig nieuwe module, dus gooi al het vorige maar weg.
Onderin staan 2 macros "zoekrijen" en "aanpassengrafiek" die met de meegestuurde parameters het vuile werk opknappen. Bovenin staan dan eigenlijk de domme macros die gewoon de parameters doorgeven, bv; Macro_EQ_25_30sim() vraagt de grafiek voor 25 periodes en 30 simulaties.
Y-as wordt nu ook netjes mee aangepast.

Public Rijen   As String                                   'deze moet bovenin de module staan
Const Afrond   As Long = 100000                            'afronden as per 100.000

Sub Macro_EQ_25_30sim()                                    'dit is de macro die de gegevens in grafiek zet voor 25 periodes en 30 simulaties
  AanpassenGrafiek 25, 30
End Sub

Sub Macro_EQ_30_5000sim()                                  'dit is de macro die de gegevens in grafiek zet voor 30 periodes en 5000 simulaties
  AanpassenGrafiek 30, 5000
End Sub

Sub AanpassenGrafiek(AantalPeriodes As Long, AantalSimulaties As Long)  'algemene macro
  Dim SplitsRij As Variant, SplitsForm As Variant, i As Integer
  ZoekRijen AantalPeriodes, AantalSimulaties               'zoek de rijen overeenkomstig gevraagde
  If Rijen = "" Then MsgBox "foutje": Exit Sub
  With Sheets("output").ChartObjects("Grafiek 1").Chart    'onze grafiek
    SplitsRij = Split(Rijen, ",")                          'splits die rijen in de reeksen
    If UBound(SplitsRij) <> 6 Then MsgBox "eigenaardig, geen 7 reeksen"
    For i = 0 To UBound(SplitsRij)                         '1 voor 1 de reeksen aflopen
      SplitsForm = Split(.SeriesCollection(i + 1).Formula, ",")  'formule voor die reeks
      SplitsForm(2) = Left(SplitsForm(2), InStr(1, SplitsForm(2), "!")) & SplitsRij(i)  'vervang in die 3e deel van de formule het bereik waarnaar verwezen wordt
      .SeriesCollection(i + 1).Formula = Join(SplitsForm, ",")  'stel de formule opnieuw samen
    Next
    .ChartTitle.Text = "Gesimuleerde equitylijnen" & Chr(13) & AantalSimulaties & " Sims / reeks van " & AantalPeriodes  'grafiektitel
    .Axes(xlValue).MinimumScale = WorksheetFunction.MRound(WorksheetFunction.Min(Sheets("MCS Equity").Range("A2").Resize(AantalSimulaties, AantalPeriodes)) - Afrond / 2 + 1, Afrond)  'ondergrens Y-as
    .Axes(xlValue).MaximumScale = WorksheetFunction.MRound(WorksheetFunction.Max(Sheets("MCS Equity").Range("A2").Resize(AantalSimulaties, AantalPeriodes)) + Afrond / 2, Afrond)  'bovengrens Y-as
  End With
  Application.Goto Sheets("output").Range("A2"), True
End Sub

Sub ZoekRijen(LaatsteKolom As Long, AantalRijen As Long)
  Dim nr As Long, lRij As Long, Getal As Double, i As Integer
  On Error GoTo fout
  With Sheets("MCS Equity")
    Rijen = ""
    For i = 1 To 7
      Select Case i
        Case 1: nr = 1                                     '1e
        Case 2: nr = WorksheetFunction.Max(2, Int(AantalRijen / 100))  '1%
        Case 3: nr = WorksheetFunction.Max(3, Int(AantalRijen / 10))  '10%
        Case 4: nr = Int(AantalRijen / 2)                  '50%
        Case 5: nr = AantalRijen - WorksheetFunction.Max(3, Int(AantalRijen / 10))  '90%
        Case 6: nr = AantalRijen - WorksheetFunction.Max(2, Int(AantalRijen / 100))  '99%
        Case 7: nr = AantalRijen                           '100%
      End Select
      lRij = WorksheetFunction.Match(WorksheetFunction.Small(.Cells(2, LaatsteKolom).Resize(AantalRijen), nr), .Columns(LaatsteKolom), 0)
      Rijen = Rijen & "," & Cells(lRij, "A").Resize(, LaatsteKolom).Address
    Next
    Rijen = Mid(Rijen, 2, Len(Rijen) - 1)
    'MsgBox Rijen
  End With
  Exit Sub
fout:
  Rijen = "": MsgBox "er is iets fout gegaan"
  End
End Sub

 

[cow18]

ik was nog even naar bovenstaande aan het kijken, nu weet ik niet hoe het in je definitieve bestand is, maar hier passen de gegevens zich iedere keer dat de map herrekent zich aan, hopelijk zijn jouw gegevens vaste waarden en geen formules met aselect of zo ?

 

[Revolutionary]

Beste cow18,

Ik heb nog geen tijd gehad om je nieuwe code te testen, maar alvast super bedankt!:d
Wat een complexe code zeg:shocked: Haal jij je kennis van VBA uit een bepaald boek of heb je het jezelf eigen gemaakt door mensen zoals ik te helpen op forums? Ik ben namelijk nog steeds op zoek naar een goed VBA boek. Ik zou zelf ook wel functies en formules in VBA willen creëren.

In het originele bestand staan dezelfde formules, maar daar heb ik automatic calculation uitgezet en ik heb een paar buttons gemaakt om ieder tabblad afzonderlijk te laten berekenen. Op die manier kan ik zelf bepalen wanneer een nieuwe simulatie gedraaid moet worden.

Als ik vanavond nog tijd heb probeer ik je code uit en anders wordt het morgenochtend.

Tim

 

[Revolutionary]

Zojuist de code getest en het werkt geweldig

Ik heb een paar kleine aanpassingen gemaakt, zoals de formules in case 1 t/m 7 omgedraaid om de legenda kloppend te maken (het laagste eindkapitaal stond in de legenda vermeld als Max en het hoogste eindkapitaal als Min, dus ik moest de formules even omdraaien). Daarnaast heb ik de regels verwijderd die de onder- en bovengrens van de Y-as bepalen, omdat anders niet altijd duidelijk te zien was wat het begin kapitaal was, omdat de lijn bijvoorbeeld ergens tussen 600.000 en 1.100.000 op de Y-as begon.
Het waren maar kleine details

De oplossing van cow18 heeft ervoor gezorgd dat ik niet meer 1 a 2 minuten moet wachten totdat de grafiek ge-update is, waardoor Excel ook nog weleens vastliep. Het updaten duurt nu nog maar 1 seconde:d

Nogmaals heel erg bedankt:thumb:
Ik zet deze vraag op opgelost.

 

[cow18]

Fijn te horen dat het snel werkt. Dat plat lopen zal ten gevolge van het sorteren zijn denk ik, die zal in die omvang nogal belastend zijn.
Die minimum en maximum van de Y-as die je in de fout brachten, dat begrijp ik niet. Ik zocht in al je gegevens dus bv 5.000 rijen bij 30 kolommen naar de grootste en kleinste waarde. De kleinste waarde werd naar beneden afgerond op een veelvoud van 100.000, de grootste naar boven afgerond eveneens op een veelvoud van 100.000. Dus kan er volgens mij geen enkel punt buiten de grafiek lopen. Heb ik me toch vergist ?

 

[Revolutionary]

Met de onder- en bovengrens van de Y-as ging het in principe ook goed. Echter als het startkapitaal 1.000.000 is dan wil ik in de grafiek graag zien dat de lijnen beginnen vanuit 1.000.000, maar deze waarde stond niet altijd op de Y-as. In het voorbeeld bestandje overigens wel hoor. Het originele bestand heeft nog een extra tabblad (dat is tabblad 2 eigenlijk). Het is een beetje lastig uit te leggen, maar ik zal het toch proberen. In tabblad 1 heb ik 30 variabelen staan, tabblad 2 kiest 2.500.000 keer ad random een variabel uit tabblad 2, in tabblad 3 worden vervolgens deze 2.500.000 variabelen vermenigvuldigd met een percentage en wordt het eindkapitaal berekend. Dit percentage kan ik vanuit tabblad 1 veranderen. Als ik dat percentage op 0,5% zet dan start de lijn mooi vanuit 1.000.000, maar als ik het percentage op 1,0% zet dan start te lijn weleenswaar ook vanuit 1.000.000, maar de 1.000.000 staat niet vermeld op de Y-as... dus visueel is niet goed te zien dat de lijn begint vanuit 1.000.000.

Zoals ik het nu beschrijf lijkt het erop dat ik de formules in tabblad 2 en 3 zou kunnen samenvoegen, maar op de uitkomsten uit tabblad 2 laat ik ook weer formules los.

 

[Revolutionary]

Ik heb toch nog een klein vraagje cow18...

In de grafiektitel zou ik ook graag het percentage willen vermelden dat in sheet Input staat in cel E2. Dus ik heb de volgende code geprobeerd, maar hij doet het niet...

    .ChartTitle.Text = "Gesimuleerde equitylijnen" & Chr(13) & AantalSimulaties & " Sims / reeks van " & AantalPeriodes & "=Input!R2C5"

Weet jij wat ik verkeerd doe?

 

[Revolutionary]

Na wat speurwerk op internet toch iets gevonden waar ik wat mee kon.

De formule is nu:

.ChartTitle.Text = "Gesimuleerde equitylijnen" & Chr(13) & AantalSimulaties & " Sims / reeks van " & AantalPeriodes & "/ " & Sheets("Input").Range("E3").Value & "% risk"

Het percentage staat eigenlijk in E2, maar de formule toont geen % in de grafiektitel, dus heb ik het iets anders opgelost. In cel E3 vermenigvuldig in het percentage uit E2 met 100 en dat gaat het wel goed.

Tim

 

[cow18]

ik zou het even moeten testen, maar het zou iets worden in de zin van

 .... & format(Sheets("Input").Range("E3").Value,"0,00%")  & " risk"

mogelijks moet die , een . zijn

 

[Revolutionary]

Wederom bedankt!:thumb:

De komma moest inderdaad een punt zijn en E3 moest E2 zijn.

Ik denk dat ik zo wel aardig uit de voeten kan voorlopig