Ir para conteúdo
Fórum Script Brasil
  • 0

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


Mauro Meira

Pergunta

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

 

image003.png

Link para o comentário
Compartilhar em outros sites

0 respostass a esta questão

Posts Recomendados

Até agora não há respostas para essa pergunta

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.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.



  • Estatísticas dos Fóruns

    • Tópicos
      152,3k
    • Posts
      652,3k
×
×
  • Criar Novo...