|
Hi again,
ok, da das inzwischen schon ziemlich lange andauert, gebe ich dir mal meine Lösung mit auf den Weg.
Option Explicit
Option Base 1
Sub Test()
Dim rng As Excel.Range
Dim aCombIdx() As Variant
Dim aL() As Variant
aCombIdx = Array(1, 1, 1, 1) '<- init, 4 Spalten
aL = Array(0#, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 1#)
Application.ScreenUpdating = False
With Range("A1")
Call .CurrentRegion.Clear
Set rng = .Resize(ColumnSize:=UBound(aCombIdx))
End With
Dim aTmp() As Variant
Dim dblSum As Double
Dim i As Long
Do
dblSum = 0
aTmp = aCombIdx
For i = 1 To UBound(aCombIdx)
aTmp(i) = aL(aCombIdx(i))
dblSum = dblSum + aTmp(i)
If dblSum > 1# Then Exit For
Next
If dblSum = 1# Then
rng.NumberFormat = "0%"
rng.Value = aTmp
Set rng = rng.Offset(RowOffset:=1)
End If
Loop While NextComb(aCombIdx, UBound(aL))
Application.ScreenUpdating = True
End Sub
Private Function NextComb(ByRef Comb() As Variant, n As Long) As Boolean
Dim i As Long
i = LBound(Comb)
Do Until i > UBound(Comb)
If Comb(i) < n Then
Comb(i) = Comb(i) + 1
Exit Do
Else
Comb(i) = 1
i = i + 1
End If
Loop
NextComb = Not (i > UBound(Comb))
End Function
Gruß
|