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)
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