Schleifendurchlauf für Zielwertsuche
04.03.2020 09:54:56
Thomas
ich würde um Hilfe bezüglich einer Zielwertsuche bitten. Diese ist eigentlich kein Problem, jedoch möchte ich die Zielwertsuche mittels Schleife wiederholen und dafür soll für "rgJahr" bei der Wiederholung der Schleife für "rgJahr" anstatt der Wert in A1 der Wert in A2 verwendet werden.
Habe das bereits mit Cells(x,1) und x+1 probiert, leider klappt das nicht und jetzt bin ich mit meinem Latein am Ende.
vl kann mit jemand helfen. Ich habe den Code etwas gekürzt zum besseren Verständnis
besten Dank
' Zielwertsuche für geeignete Eigenkapitalquote bei CF VuV in verschiedenen Jahren gleich 0
_
_
Sub Zielwertsuche()
Dim rgRohertrag As Range
Dim rgFK As Range
Dim rgTPErgebnis As Range
Dim rgFilter As Range
Dim rgErgebnis As Range
Dim wbneu As Workbook
Dim wbkalk As Workbook
Dim strPfadwbneu As String, strBezeichnungwbneu As String, strNamewbneu As String
Dim BlattName As String
Dim strBezNB As String, strBezNT As String
Dim lngLastRowEG As Long
Dim lngRohertrag As Long
Dim lngFKQ As Long
Dim i As Integer
Dim rgJahr As Range
Dim rgTest As Integer
'Definition von Kalkulator (dieses WB)
Set wbkalk = wb_kalk
'Marktmiete in Zwischenspeicher speichern
lngRohertrag = www.Range("d_Rohertrag_pa").Value
'Variablen von Rohertrag Rohertrag und CF VuV definieren
Set rgRohertrag = www.Range("d_Rohertrag_pa")
Set rgFK = www.Range("d_Fremdkapitalquote")
'Bereiche für Advanced Filter definiert
Set rgTPErgebnis = TP.Range("TP_Auswertung")
Set rgFilter = Filter.Range("Filter")
'Schleife
For i = 1 To 10 Step 1
rgJahr = Range.Cells(i, 1)
'Zielwertsuche veränderbar FKQ
rgJahr.GoalSeek Goal:=0, ChangingCell:=rgFK
'letzte beschriebene Zeile in Blatt neues WB identifizieren
lngLastRowEG = wbneu.Sheets(BlattName).Cells(Rows.Count, 4).End(xlUp).Row
'wbkalk.Activate
'Bereiche für Advanced Filter definiert
Set rgErgebnis = wbneu.Worksheets(BlattName).Range("A" & lngLastRowEG + 1)
rgTPErgebnis.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=rgFilter, CopyToRange:=rgErgebnis, _
Unique:=False
Next i
End Sub