Variation mit Zurücklegen - VBA Code
24.10.2016 10:56:06
Nel
ich möchte gerne, dass mein VBA Code automatisch sämtliche Variationen mit zurücklegen (n^k) für mich berechnet, wobei n=8 und k = 4. Je Variation ergibt sich ein neuer Wert in den Zellen D15:AL15. Der Code soll mir nicht alle Variationsmöglichkeiten in ein anderes Worksheet schreiben, sondern stattdessen die sich bei jeder variation ändernden Werte der Zellen D15:AL15. D. h. VBA soll eine von x Variationen berechnen und dann die Werte in D15:AL15 in ein zweites Worksheet in die Zelle A2:AL2 schreiben (kopieren). Dann soll der Code die nächste Variation berechnen und die Ergebnisse in D15:AL15 in das zweite Worksheet in die Zelle A3:Al3 schreiben usw. bis entsprechend alle Variationen durch sind.
Bisher habe ich folgenden Code. Den versuche ich auf meine Bedürfnisse abzustimmen, was mir aber nicht wirklich von der Hand geht.
Könnt ihr mir helfen?
Danke
Sub VariationMitZuruecklegenArray(ByVal n As Integer, ByVal k As Integer)
Dim ar As Variant, i As Long, j As Integer, lngSize As Long
Dim wks1 As Worksheet, wks2 As Worksheet
Set wks1 = Worksheets("Org&Env")
Set wks2 = Worksheets("Makro")
lngSize = WorksheetFunction.Combin(n - 1 + k, k)
ReDim ar(1 To lngSize, 1 To k)
For j = 1 To k
ar(1, j) = 1 ' ar(1, j) = 0 ' um ab 0 zu zählen
Next
For i = 2 To lngSize
For j = 1 To k
ar(i, j) = ar(i - 1, j)
Next
arInc ar, i, n, k, k ' arInc ar, i, n - 1, k, k ' um ab 0 zu zählen
Next
Range("A1").Resize(lngSize, k) = ar
End Sub
Sub arInc(ByRef ar As Variant, ByVal i As Long, ByVal n As Integer, ByVal k As Integer, ByVal _
_
intSpalte As Integer)
Dim intVal As Integer, j As Integer
If ar(i, intSpalte)
intVal = ar(i, intSpalte) + 1
For j = intSpalte To k
ar(i, j) = intVal
Next
Else
arInc ar, i, n, k, intSpalte - 1
End If
End Sub
Sub TestIt()
Dim n As Integer, k As Integer, t As Single
n = 8
k = 4
t = Timer
VariationMitZuruecklegenArray n, k
Debug.Print "Array", Timer - t
End Sub