Working Paper Series - Institut für Finanzwirtschaft - Technische ...

Appendix B: Programmcode der Excel-Makros XX
2. Makro für die Berechnung der Diskontierungszinssätze im Szenario
Sub DZS_Szenarien_ErtragsW()
Dim i As Integer, d As Integer, SetCell As Range, ByChangingCell As Range, ValueCell
As Range
Dim DZS As Range, WachsME As Range, WachsBK As Range, WachsIK As Range,
WachsVK As Range, WachsMAW As Range
Dim DZSWert As Range
Set DZSWert = Worksheets("Szenarien_DSZ ErtragsW als RW").Range("C9")
Set WachsME = Worksheets("Szenarien_DSZ ErtragsW als RW").Range("C2")
Set WachsBK = Worksheets("Szenarien_DSZ ErtragsW als RW").Range("C3")
Set WachsIK = Worksheets("Szenarien_DSZ ErtragsW als RW").Range("C4")
Set WachsVK = Worksheets("Szenarien_DSZ ErtragsW als RW").Range("C5")
Set WachsMAW = Worksheets("Szenarien_DSZ ErtragsW als RW").Range("C6")
Application.ScreenUpdating = False
For d = 1 To 21
Set DZS = Range("F5")
Set SetCell = Range("D5")
Set ByChangingCell = Range("B5")
Set ValueCell = Range("C5")
Worksheets("MietE").Range("D2").Value = WachsME
Worksheets("BetriebsK").Range("D2").Value = WachsBK
Worksheets("InstandhaltungsK").Range("D2").Value = WachsIK
Worksheets("VerwaltungsK").Range("D2").Value = WachsVK
Worksheets("MietausfallW").Range("D2").Value = WachsMAW
For i = 1 To 636
SolverReset
SolverOk SetCell:=SetCell.Address(True, True), _
ByChange:=ByChangingCell.Address(True, True), _
MaxMinVal:=3, ValueOf:=CStr(ValueCell.Value)
SolverSolve UserFinish:=True
Set SetCell = SetCell.Offset(1, 0)
Set ByChangingCell = ByChangingCell.Offset(1, 0)
Set ValueCell = ValueCell.Offset(1, 0)
DZSWert = DZS
Set DZS = DZS.Offset(1, 0)
Set DZSWert = DZSWert.Offset(1, 0)