Bom Dia a Todos
Gostaria da ajuda de Vc´s neste arquivo, pequei uma macro que um colega fez pra mim, esta macro faz combinações de números, mas esses valores apresentam na listbox sempre a mesma sequência de números de 1 á ...., eu gostaria que estas combinações fosse através dos números discritos na TextBox4 , segue figura de exemplo e código.
Grato a Todos
Mauro
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
Pergunta
Mauro Meira
Bom Dia a Todos
Gostaria da ajuda de Vc´s neste arquivo, pequei uma macro que um colega fez pra mim, esta macro faz combinações de números, mas esses valores apresentam na listbox sempre a mesma sequência de números de 1 á ...., eu gostaria que estas combinações fosse através dos números discritos na TextBox4 , segue figura de exemplo e código.
Grato a Todos
Mauro
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
Link para o comentário
Compartilhar em outros sites
0 respostass a esta questão
Posts Recomendados
Participe da discussão
Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.