Tab mit Wertebereich rechnen + Ergebnisse loggen
Christian
folgende Aufgabe möchte ich automatisieren:
Ich muss immer mal wieder Vergleichsrechnungen in großen Tabellen anstellen, in denen sich meist nur 1 Wert ändert.
Bisher habe ich jedesmal den Wert geändert, Ergebnis notiert, neuer Wert, wieder notiert u.s.w.
Nun möchte eine Routine schreiben, mit der ich:
1. Festlegen kann in welcher Zelle der Wert geändert werden soll.
2. Mit welchem Startwert ich anfangen will.
3. Festlegen in welchem Intervall (z.B. 1 bis 10 in 2erschritten) der Wert geändert werden soll
4. Festlegen welche Ergebniszelle ausgelesen werden soll.
5. Festlegen in welcher Zelle beginnend das ausgelesene Ergebnis geschrieben werden soll und
5. Den Durchlauf starten und nach jedem Durchlauf das ausgelesene Ergebnis untereinander in eine Spalte loggen kann.
Ich habe bereits einen ganz ähnlichen Code zusammengefunden, der in etwa das macht, was ich auch brauche, jedoch nur weniger flexibilät. Ich muss zugeben, dass ich es aber nicht so hinbekomme, wie es am Ende aussehen soll.
Ich würde mich freuen, wenn jemand ein paar Ideen dazu hat. Der Basiscode steht unten:
Sub PPA_Sensitivity(s_type, S_IRR, i_first_row, S_output_variable, S_output_result)
Dim s_set_value As String
Dim S_sheet As String
Dim i_set_row As Integer
Dim S_equ As String
Dim A_results(1000, 2) As Variant
Dim i_numloop As Integer
Dim II As Integer
Dim b_is_array As Boolean
Dim S_Original_location As String
'clear the contents of the results sheet for the rows to be reported
Sheets("Sensitivity Results").Select
Range(S_output_variable + "3:" + S_output_result + "10000").Select
Selection.ClearContents
i_set_row = i_first_row
S_equ = S_IRR
S_sheet = "Sensitivity analysis"
'select sensitivity sheet
Sheets(S_sheet).Select
'Turn off all the autofiltering
Sheets(S_sheet).AutoFilterMode = False
'find the original location of the data
S_Original_location = Right(Worksheets(S_sheet).Range("B" + CStr(i_set_row)).Formula,
Len(Worksheets(S_sheet).Range("B" + CStr(i_set_row)).Formula) - 1)
'store the set value in an internal variable for later usage.
b_is_array = Worksheets("Project Data").Range(S_Original_location).HasArray
s_set_value = Worksheets("Project Data").Range(S_Original_location).Formula
'Calculate the number loops that need to be made
i_numloop = CInt((Worksheets(S_sheet).Range("B" + CStr(i_set_row + 2)).Value -
Worksheets(S_sheet).Range("B" + CStr(i_set_row + 1)).Value) / Worksheets(S_sheet).
Range("B" + CStr(i_set_row + 3)).Value)
'write the variable in question to the results sheet
If s_type = "IRR" Then
Worksheets("Sensitivity Results").Range(S_output_result + CStr(2)).Value = "IRR"
End If
For II = 0 To i_numloop
A_results(II, 0) = Worksheets(S_sheet).Range("B" + CStr(i_set_row + 1)).Value + _
Worksheets(S_sheet).Range("B" + CStr(i_set_row + 3)).Value * II
'put the current value in the cell on the project description page
Worksheets("Project Data").Range(S_Original_location).Value = A_results(II, 0)
Calculate
A_results(II, 1) = Worksheets("Cash Flow").Range(S_equ).Value
'Write the data to the results sheet
Worksheets("Sensitivity Results").Range(S_output_variable + CStr(II + 3)).Value = _
A_results(II, 0)
Worksheets("Sensitivity Results").Range(S_output_result + CStr(II + 3)).Value = _
A_results(II, 1)
Next II
'Now put the original value back into the project data sheet
If b_is_array Then
Worksheets("Project Data").Range(S_Original_location).FormulaArray = s_set_value
Else
Worksheets("Project Data").Range(S_Original_location).Value = s_set_value
End If
End Sub