Combinações de núme...
 
Notifications
Clear all

Combinações de números em Formulário_Excel

3 Posts
2 Usuários
0 Reactions
864 Visualizações
(@mauromeira)
Posts: 0
New Member
Topic starter
 

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
 
Postado : 02/08/2016 9:25 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!

O que você precisa, deve ser o que está no arquivo feito pelo MVP shg.

Att

 
Postado : 08/08/2016 2:01 pm
(@mauromeira)
Posts: 0
New Member
Topic starter
 

Boa Tarde Alexandre

Obrigado pela ajuda.

Abraço
Mauro

 
Postado : 08/08/2016 2:25 pm