Hallo Werner,
hab vielen Dank für deine Antwort. Dank dieser habe ich erkannt, dass ich vergessen habe, zu erklären, was ich machen möchte.
'Hier beginnt die Schleife
Worksheets("TAB1").Range("B2:K2").Select 'Zeile +1 bei jeder Wiederholung
'Hier endet die Schleife und soll sich wiederholen.
Hierbei wird immer die nächste Zeile markiert. Also B2:K2, dann B3:K3, dann B4:K4 usw. Dies ist meine Datengrundlage. In den Zeilen stehen mögliche Kombinationen von jeweils 2 Optionen je einzelner Zelle.
Sheets("TAB2").Select
Range("B3").Select
ActiveSheet.Paste
ActiveSheet.Paste
Auf TAB2 wird der Bereich B2:K2 usw. dann eingefügt. Damit erfolgt eine Berechnung, die sich für jede B2:K2 usw. wiederholt. Diese Berechnung ist schon in Excel eingearbeitet und durchaus komplex. Für jede Bx:Kx gibt es je Zelle 14 verschiedene Variablen. Angeschlossen daran ist noch eine Berechnung, zu wieviel % die einzelnen Variablen ihre eigene Vorgabe erfüllen.
Sheets("TAB3").Select
Range("J31,J32,J33,J35,J36,J38,J40,J42,J43,J45,J46,J48,J49,J51").Select
Selection.Copy
Sheets("TAB1").Select
Range("N12").Select 'Spalte +1 nach rechts bei jeder Wiederholung
Das Ergebnis der Berechnung wird immer in dem Bereich Jx:Jx angezeigt und demzufolge nachgängig kopiert und auf TAB1 eingefügt.
Sheets("TAB1").Select
Range("N12").Select 'Spalte +1 nach rechts bei jeder Wiederholung
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("N27").Select 'Spalte +1 nach rechts bei jeder Wiederholung
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=IFERROR(IF(R[-15]C>1,1,R[-15]C),0)"
Range("N27:N40").Select 'Spalte +1 nach rechts bei jeder Wiederholung
Selection.FillDown
Range("N41").Select 'Spalte +1 nach rechts bei jeder Wiederholung
ActiveCell.FormulaR1C1 = "=SUM(R[-14]C:R[-1]C)/14"
Hier werden noch Formeln in weitere Zellen eingearbeitet, die eine Transformation der Grunddaten vornehmen.
Das ganze soll dann als Schleife mit variabler Anzahl durchlaufen werden, bspw. 2^10 Mal.
Ich habe gestern noch mal neu angefangen zu schreiben und konnte eine funktionierende Schleife codieren. Nachfolgend der Code:
For i = 1 To nKombi 'nKombi = Anzahl möglicher Kombinationen
Worksheets("TAB1").Select
Worksheets("TAB1").Range("B" & 1 + i & ",C" & 1 + i & _
",D" & 1 + i & ",E" & 1 + i & ",F" & 1 + i & ",G" & 1 + i & ",H" _
& 1 + i & ",I" & 1 + i & ",J" & 1 + i & ",K" & 1 + i).Select
Application.CutCopyMode = False
Selection.Copy
Worksheets("TAB2").Select
Cells(3, 2).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Worksheets("TAB3").Select
Range("J31,J32,J33,J35,J36,J38,J40,J42,J43,J45,J46,J48,J49,J51").Select
Selection.Copy
Worksheets("TAB1").Select
Cells(12, 13 + i).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Cells(27, 13 + i).Select
Application.CutCopyMode = False
Cells(27, 13 + i).Select
ActiveCell.FormulaR1C1 = "=IFERROR(IF(R[-15]C>1,1,R[-15]C),0)"
Cells(28, 13 + i).Select
ActiveCell.FormulaR1C1 = "=IFERROR(IF(R[-15]C>1,1,R[-15]C),0)"
Cells(29, 13 + i).Select
ActiveCell.FormulaR1C1 = "=IFERROR(IF(R[-15]C<1,1,R[-15]C),0)"
Cells(30, 13 + i).Select
ActiveCell.FormulaR1C1 = "=IFERROR(IF(R[-15]C>1,1,R[-15]C),0)"
Cells(31, 13 + i).Select
ActiveCell.FormulaR1C1 = "=IFERROR(IF(R[-15]C>1,1,R[-15]C),0)"
Cells(32, 13 + i).Select
ActiveCell.FormulaR1C1 = "=IFERROR(IF(R[-15]C>1,1,R[-15]C),0)"
Cells(33, 13 + i).Select
ActiveCell.FormulaR1C1 = "=IFERROR(IF(R[-15]C>1,1,R[-15]C),0)"
Cells(34, 13 + i).Select
ActiveCell.FormulaR1C1 = "=IFERROR(IF(R[-15]C<1,1,R[-15]C),0)"
Cells(35, 13 + i).Select
ActiveCell.FormulaR1C1 = "=IFERROR(IF(R[-15]C>1,1,R[-15]C),0)"
Cells(36, 13 + i).Select
ActiveCell.FormulaR1C1 = "=IFERROR(IF(R[-15]C>1,1,R[-15]C),0)"
Cells(37, 13 + i).Select
ActiveCell.FormulaR1C1 = "=IFERROR(IF(R[-15]C>1,1,R[-15]C),0)"
Cells(38, 13 + i).Select
ActiveCell.FormulaR1C1 = "=IFERROR(IF(R[-15]C>1,1,R[-15]C),0)"
Cells(39, 13 + i).Select
ActiveCell.FormulaR1C1 = "=IFERROR(IF(R[-15]C<1,1,R[-15]C),0)"
Cells(40, 13 + i).Select
ActiveCell.FormulaR1C1 = "=IFERROR(IF(R[-15]C<1,1,R[-15]C),0)"
Cells(41, 13 + i).Select
ActiveCell.FormulaR1C1 = "=SUM(R[-14]C:R[-1]C)/14"
Next i
Der Code, den ich jetzt habe funktioniert ganz gut und macht auch was er soll. Gibt es Verbesserungen, dann immer her damit. Ich hoffe ich konnte den Prozess nun besser darlegen und verständlich machen.
Grüße Mike
|