none
Combinação e Permutação de números

    Question

  • Bom Dia a Todos

    Fiz uma vasta pesquisa pela net em busca de um código em vba que retornasse a quantidade de combinação do número 10 sendo de 5 casas decimais, sei que o valor total de combinações é de 252, mas como exibir estes valores em uma ListBox, apartir de um userform que contenha a textbox1 e textbox2 para digitar os valores da pesquisa e a listbox para exibir estas 252 combinações, mas infelizmente não achei nada, por isso venho pedir aos colegas do fórum se  alguém pudesse elaborar este código ou um link que tenha este código, desde já agradeço.

    Abraço a todos.

    Mauro

    Monday, October 15, 2012 4:38 PM

Answers

  • Deixo-te um metodo feito por mim para apresentar uma determinada combinação de entre todas as combinações possiveis.

    Neste metodo atribuo a cada combinação um numero de ordem.

    Usei isto num programa para analise do totoloto à mais de dez anos.

    Junto um procedimento para um botão que irá fazer o que pretendes:

    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)
        TextBox3.Text = 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
    

    • Marked as answer by MauroMeira Tuesday, October 16, 2012 12:02 PM
    Monday, October 15, 2012 8:54 PM

All replies

  • Deixo-te um metodo feito por mim para apresentar uma determinada combinação de entre todas as combinações possiveis.

    Neste metodo atribuo a cada combinação um numero de ordem.

    Usei isto num programa para analise do totoloto à mais de dez anos.

    Junto um procedimento para um botão que irá fazer o que pretendes:

    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)
        TextBox3.Text = 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
    

    • Marked as answer by MauroMeira Tuesday, October 16, 2012 12:02 PM
    Monday, October 15, 2012 8:54 PM
  • Caro Amigo Nando Freitas

    Gostaria de agradecer pela ajuda, este é o código que procurava.

    Abraço

    Mauro

    Tuesday, October 16, 2012 12:01 PM