Ihhh nem precisa, já achei a resposta. Vlw
Sub Combinations(Optional v As Variant)
Dim n As Integer, m As Integer
Dim rng As Range
numcomb = 2
If IsMissing(v) Then
v = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
End If
ReDim Preserve v(1 To 10)
n = UBound(v, 1)
For m = 1 To 10
'm = 1
ss = ""
'' Range("A3").Select
Comb2 n, m, 1, "'", v
'MsgBox ss
Next m
End Sub
'Generate combinations of integers k..n taken m at a time, recursively
Sub Comb2(ByVal n As Integer, ByVal m As Integer, _
ByVal k As Integer, ByVal s As String, v As Variant)
Dim v1 As Variant
If m > n - k + 1 Then Exit Sub
If m = 0 Then
v1 = Split(Replace(Trim(s), "'", ""), " ")
sss = ""
For i = LBound(v1) To UBound(v1)
sss = sss & v(v1(i)) & " "
ActiveCell.Offset(0, i) = v(v1(i))
Next
ActiveCell.Offset(0, 8) = sss
ActiveCell.Offset(1, 0).Select
ss = ss & sss & vbNewLine
Exit Sub
End If
Comb2 n, m - 1, k + 1, s & k & " ", v
Comb2 n, m, k + 1, s, v
End Sub
Postado : 24/05/2016 11:44 am