AW: Ein Makro für mehrere Tabellenblätter
11.08.2004 14:53:02
Claudi
Sub KorrBerechnung(TabName as String)
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim runterAnzahl As Integer
Dim rechtsAnzahl As Integer
Dim runterAnzahlRendite As Integer
Dim WS5 As Worksheet
Dim Zeitpunkte As Variant
Dim SpaltenId As Integer
Dim SumProd As Double
Dim Summe As Double
Dim s As Double
Dim StandAbw As Double
Dim Varianz As Double
Dim StandAbwKorrel As Double
Dim Korrel As Double
Dim Sum As Double
'Mappe1 aktivieren
'Workbooks("Zinsstrukturkurven.xls").Activate
'Tabelle1 aktivieren
SpaltenId = 14
Zeitpunkte = Array((1 / 12), 0.25, 0.5, 1, 2, 3, 4, 5, 7, 9, 10, 15, 20, 30)
'Gibt die Anzahl der Werte nach unten aus
runterAnzahl = Range("A8", Range("A8").End(xlDown)).Count
'Berechnen alle Renditen die unter einem Jahr liegen
For i = 1 To 3 Step 1
For j = 8 To 257 Step 1
Cells(j, i + 15) = Zeitpunkte(i - 1) * _
Application.WorksheetFunction.Ln((1 + (Cells(j + 1, i)) / 100) / (1 + (Cells(j, i)) / 100))
Next j
Next i
'Berechnet alle Renditen die über einem Jahr liegen
runterAnzahlRendite = Range("P8", Range("P8").End(xlDown)).Count
For i = 4 To 14 Step 1
For j = 8 To 257 Step 1
If Cells(j, i) <> "#N/A The record could not be found" Then
Cells(j, i + 15) = Zeitpunkte(i - 1) * ((Cells(j + 1, i)) / 100 - (Cells(j, i)) / 100)
End If
Next j
Next i
'Worksheets("Start").Activate
'MsgBox "Aktualisierung der Renditen, Standardabaweichungen und Korrelationen erfolgreich beendet!"
rechtsAnzahl = Range("P8", Range("P8").End(xlToRight)).Count
'Berechnung der Standardabweichung
For i = 16 To rechtsAnzahl + 15 Step 1
For k = 8 To (runterAnzahlRendite + 7) Step 1
s = Summe
SumProd = (CStr(Cells(k, i)) * CStr(Cells(k, i)))
Summe = SumProd + s
Next k
Sum = Summe / runterAnzahlRendite
StandAbw = Sqr(Sum)
'Summe muss wieder auf Null gesetzt werden, da ansonsten die Summe der vorher
'ausgeführten Berechnung mit dazu gerechnet würde
' Übergibt die berechneten Werte in das Tabellenblatt
Cells(3, i + 16) = StandAbw
'Varianz berechnen
Varianz = Sum
Cells(4, i + 16) = Varianz
Summe = 0
Next i
'Berechnung der Korrelation
For i = 16 To rechtsAnzahl + 15 Step 1
'Schleife geht auch nach rechts, aber häufiger
For j = 16 To rechtsAnzahl + 15 Step 1
'Schleife liest die Zeilen nach unten hin aus und es wird multipliziert
'und anschließend addiert
For k = 8 To (runterAnzahlRendite + 7) Step 1
s = Summe
SumProd = (CStr(Cells(k, i))) * (CStr(Cells(k, j)))
Summe = SumProd + s
Next k
Sum = Summe / runterAnzahlRendite
StandAbwKorrel = (CStr(Cells(3, i + 16)) * CStr(Cells(3, j + 16)))
Korrel = Sum / StandAbwKorrel
'Summe muss wieder auf Null gesetzt werden, da ansonsten die Summe der vorher
'ausgeführten Berechnung mit dazu gerechnet würde
Summe = 0
' Übergibt die berechneten Werte in das Tabellenblatt
Cells(j - 8, i + 16) = Korrel
Next j
Next i
End Sub