Este fórum está sendo desativado

[MauroMeira]

Boa Noite a Todos
Gostaria da ajuda de Vc´s neste arquivo, pequei um formulário na net que faz combinações de números, mas eu gostaria que estas combinações fosse através dos números discriminados na TextBox4, segue figuras e código e arquivo.



Public Function Combinacoes(Grupo As Integer, Elementos As Integer) As Long
If Elementos < 1 Or Grupo < 1 Or Elementos > Grupo Then Exit Function
' M!/(M-N)!/N! convertida
'Combinações = Factorial(Grupo) / Factorial(Grupo - Elementos) / Factorial(Elementos)
Dim T As Double, a As Integer
T = 1
For a = 1 To Grupo - Elementos
T = T * (a + Elementos) / a
Next a
Combinacoes = T
End Function
Public Function GetSeqCombinacoes(Grupo As Integer, Elementos As Integer, NrComb As Long) As Integer()
Dim a As Integer, b As Integer, c As Integer
Dim N As Double, m As Double, SS() As Integer
If NrComb < 1 Then NrComb = 1
If NrComb > Combinacoes(Grupo, Elementos) Then Exit Function
N = NrComb - 1: c = Grupo
ReDim Preserve SS(Elementos)
For a = Elementos To 1 Step -1
For b = c To a Step -1
m = Combinacoes(b - 1, a)
If N >= m Then
N = N - m
SS(a) = b
c = b - 1
Exit For
End If
Next b
Next a
GetSeqCombinacoes = SS
End Function
Public Function NumsSeqCombinacoes(Grupo As Integer, Elementos As Integer, NrComb As Long, Optional Separador As String = " ") As String
Dim I As Integer, S As String
Dim NRS() As Integer
NRS = GetSeqCombinacoes(Grupo, Elementos, NrComb)
If UBound(NRS) <> Elementos Then Exit Function
If Elementos > 0 Then S = NRS(1)
For I = 2 To Elementos
S = S & Separador & NRS(I)
Next I
NumsSeqCombinacoes = S
End Function

'Formulário
Private Sub CommandButton1_Click()
ListBox1.Clear
Dim I As Long, T As Double
Dim N As Integer, E As Integer
N = Val(TextBox1.Text)
E = Val(TextBox2.Text)
T = Combinacoes(N, E)
Label6.Caption = T
If T > 1000 Then T = 1000 'Limite optional para não sobrecarregar a listbox
For I = 1 To T
ListBox1.AddItem NumsSeqCombinacoes(N, E, I)
Next I
End Sub


Grato a Todos
Mauro