MauroMeira
Mensagens : 3 Data de inscrição : 14/10/2015 Idade : 55 Localização : Guarulhos
| Assunto: Combinações de números em Formulário_Excel Ter Ago 02, 2016 6:37 pm | |
| 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 - Código:
-
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
| |
|