VBA - combinations

Joined
Aug 4, 2015
Messages
1
Reaction score
0
I need help I have no experience in programming.
I would like to adapt the code below to generate combinations of 5 dozens per line and 5 scores by column generating 50 scores of 100 .
Can someone help? Web not working
Boa noite sou novo em programação e estou tentando fazer rodar o código abaixo alguém pode ajudar?

Option Explicit

'C(n, p) = n! / ((n-p)! * p!)
'lPermutações a ser definido, seria o 'p' da fórmula acima
Const lPermutações As Long = 50
Dim r As Long
Dim wkb As Workbook
Dim wks As Worksheet
Dim intGrupo As Integer
Dim x As Byte 'apenas um contador para o laço
Dim v(1 To 100)
Sub Teste()

Dim lElementos As Long

'Popula vetor de elementos
For x = 1 To 100 'coloquei em um laço pro código ficar mais limpo
v(x) = CStr(x)
Next x

intGrupo = 0 'inicia o numero do grupo

'C(n, p) = n! / ((n-p)! * p!)
'lElementos seria o 'n' da fórmula acima
lElementos = UBound(v) - LBound(v) + 1

'Contador de linhas para uso no Excel:
r = 0

'Limpa Planilha ativa
' Cells.Delete

'Inicia recursão:
Combinação lElementos, lPermutações, 1
'aqui salva o último wbk aberto após fazer todas as permutações
wkb.SaveAs ThisWorkbook.Path & "\perm" & intGrupo & ".xlsx"
wkb.Close


End Sub

Sub Combinação(n As Long, p As Long, k As Long, Optional s As String)


If p > n - k + 1 Then Exit Sub

If p = 0 Then
'Para visualizar o resultado de uma combinação no Excel:

If r = 0 And wkb Is Nothing Then 'aqui se a linha for zero,

Set wkb = Workbooks.Add
Set wks = wkb.Sheets.Add 'adicionar uma nova guia
intGrupo = intGrupo + 1 'incrementar o numero do grupo
wks.Name = "grupo " & intGrupo 'renomear a guia pelo nome do grupo

End If


If funVerificaPermitacao(s) Then

r = r + 1
wks.Cells(r, "A").Resize(1, lPermutações) = Split(s, "|")

'Else
'Debug.Print s 'Apenas para verificar as condicoes que não entravam
End If

'Se quiser visualizar o resultado na Janela de Verificação imediata, use:
'Debug.Print s
If r = 100000 Then 'se a linha for igual a cem mil, salvar o wbk

wkb.SaveAs ThisWorkbook.Path & "\perm" & intGrupo & ".xlsx"
wkb.Close
Set wkb = Nothing
r = 0 'resetar o numero da linha

End If

Exit Sub

End If

'Recorre novamente:
Combinação n, p - 1, k + 1, s & v(k) & "|"
'Recorre novamente a partir do elemento anterior:
Combinação n, p, k + 1, s

End Sub
Function funVerificaPermitacao(strSequencia As String) As Boolean


funVerificaPermitacao = False

Dim arrValores() As String
Dim bytValor As Byte
Dim intDiferenca As Integer

Dim intSoma As Integer
Dim blnEstaEmSequencia As Boolean

Dim bytTotalPar As Byte
Dim bytTotalImpar As Byte

Dim dez As Integer: Dim vinte As Integer: Dim trinta As Integer: Dim quarenta As Integer
Dim cincoenta As Integer: Dim sessenta As Integer: Dim setenta As Integer
Dim oitenta As Integer: Dim noventa As Integer: Dim cem As Integer

Dim final1 As Integer: Dim final2 As Integer: Dim final3 As Integer: Dim final4 As Integer
Dim final5 As Integer: Dim final6 As Integer: Dim final7 As Integer: Dim final8 As Integer
Dim final9 As Integer: Dim final10 As Integer

arrValores = Split(strSequencia, "|")

dez = 0: vinte = 0: trinta = 0: quarenta = 0: cincoenta = 0:
sessenta = 0: setenta = 0: oitenta = 0: noventa = 0: cem = 0
final1 = 0: final2 = 0: final3 = 0: final4 = 0: final5 = 0: final6 = 0: final7 = 0: final8 = 0
final9 = 0: final10 = 0

For bytValor = 0 To 99

If arrValores(bytValor) = 1 Or arrValores(bytValor) = 11 Or arrValores(bytValor) = 21 Or arrValores(bytValor) = 31 Or arrValores(bytValor) = 41 Or _
arrValores(bytValor) = 51 Or arrValores(bytValor) = 61 Or arrValores(bytValor) = 71 Or arrValores(bytValor) = 81 Or arrValores(bytValor) = 91 Then
final1 = final1 + 1
End If
If arrValores(bytValor) = 2 Or arrValores(bytValor) = 12 Or arrValores(bytValor) = 22 Or arrValores(bytValor) = 32 Or arrValores(bytValor) = 42 Or _
arrValores(bytValor) = 52 Or arrValores(bytValor) = 62 Or arrValores(bytValor) = 72 Or arrValores(bytValor) = 82 Or arrValores(bytValor) = 92 Then
final2 = final2 + 1
End If
If arrValores(bytValor) = 3 Or arrValores(bytValor) = 13 Or arrValores(bytValor) = 23 Or arrValores(bytValor) = 33 Or arrValores(bytValor) = 43 Or _
arrValores(bytValor) = 53 Or arrValores(bytValor) = 63 Or arrValores(bytValor) = 73 Or arrValores(bytValor) = 83 Or arrValores(bytValor) = 93 Then
final3 = final3 + 1
End If
If arrValores(bytValor) = 4 Or arrValores(bytValor) = 14 Or arrValores(bytValor) = 24 Or arrValores(bytValor) = 34 Or arrValores(bytValor) = 44 Or _
arrValores(bytValor) = 54 Or arrValores(bytValor) = 64 Or arrValores(bytValor) = 74 Or arrValores(bytValor) = 84 Or arrValores(bytValor) = 94 Then
final4 = final4 + 1
End If
If arrValores(bytValor) = 5 Or arrValores(bytValor) = 15 Or arrValores(bytValor) = 25 Or arrValores(bytValor) = 35 Or arrValores(bytValor) = 45 Or _
arrValores(bytValor) = 55 Or arrValores(bytValor) = 65 Or arrValores(bytValor) = 75 Or arrValores(bytValor) = 85 Or arrValores(bytValor) = 95 Then
final5 = final5 + 1
End If
If arrValores(bytValor) = 6 Or arrValores(bytValor) = 16 Or arrValores(bytValor) = 26 Or arrValores(bytValor) = 36 Or arrValores(bytValor) = 46 Or _
arrValores(bytValor) = 56 Or arrValores(bytValor) = 66 Or arrValores(bytValor) = 76 Or arrValores(bytValor) = 86 Or arrValores(bytValor) = 96 Then
final6 = final6 + 1
End If
If arrValores(bytValor) = 7 Or arrValores(bytValor) = 17 Or arrValores(bytValor) = 27 Or arrValores(bytValor) = 37 Or arrValores(bytValor) = 47 Or _
arrValores(bytValor) = 57 Or arrValores(bytValor) = 67 Or arrValores(bytValor) = 77 Or arrValores(bytValor) = 87 Or arrValores(bytValor) = 97 Then
final7 = final7 + 1
End If
If arrValores(bytValor) = 8 Or arrValores(bytValor) = 18 Or arrValores(bytValor) = 28 Or arrValores(bytValor) = 38 Or arrValores(bytValor) = 48 Or _
arrValores(bytValor) = 58 Or arrValores(bytValor) = 68 Or arrValores(bytValor) = 78 Or arrValores(bytValor) = 88 Or arrValores(bytValor) = 98 Then
final8 = final8 + 1
End If
If arrValores(bytValor) = 9 Or arrValores(bytValor) = 19 Or arrValores(bytValor) = 29 Or arrValores(bytValor) = 39 Or arrValores(bytValor) = 49 Or _
arrValores(bytValor) = 59 Or arrValores(bytValor) = 69 Or arrValores(bytValor) = 79 Or arrValores(bytValor) = 89 Or arrValores(bytValor) = 99 Then
final9 = final9 + 1
End If
If arrValores(bytValor) = 10 Or arrValores(bytValor) = 20 Or arrValores(bytValor) = 30 Or arrValores(bytValor) = 40 Or arrValores(bytValor) = 50 Or _
arrValores(bytValor) = 60 Or arrValores(bytValor) = 70 Or arrValores(bytValor) = 80 Or arrValores(bytValor) = 90 Or arrValores(bytValor) = 100 Then
final10 = final10 + 1
End If

If arrValores(bytValor) < 11 Then
dez = dez + 1
End If
If arrValores(bytValor) > 10 And arrValores(bytValor) < 21 Then
vinte = vinte + 1
End If
If arrValores(bytValor) > 20 And arrValores(bytValor) < 31 Then
trinta = trinta + 1
End If
If arrValores(bytValor) > 30 And arrValores(bytValor) < 41 Then
quarenta = quarenta + 1
End If
If arrValores(bytValor) > 40 And arrValores(bytValor) < 51 Then
cincoenta = cincoenta + 1
End If
If arrValores(bytValor) > 50 And arrValores(bytValor) < 61 Then
sessenta = sessenta + 1
End If
If arrValores(bytValor) > 60 And arrValores(bytValor) < 71 Then
setenta = setenta + 1
End If
If arrValores(bytValor) > 70 And arrValores(bytValor) < 81 Then
oitenta = oitenta + 1
End If
If arrValores(bytValor) > 80 And arrValores(bytValor) < 91 Then
noventa = noventa + 1
End If
If arrValores(bytValor) > 90 And arrValores(bytValor) < 101 Then
cem = cem + 1
End If


Next bytValor
' só pode entrar até 5 por coluna
If final1 > 5 Or final2 > 5 Or final3 > 5 Or final4 > 5 Or final5 > 5 Or final6 > 5 Or _
final7 > 5 Or final8 > 5 Or final9 > 5 Or final10 > 5 Then
funVerificaPermitacao = False
Else
funVerificaPermitacao = True

End If
' só pode entrar até 5 por linha
If dez > 5 Or vinte > 5 Or trinta > 5 Or quarenta > 5 Or cincoenta > 5 Or sessenta > 5 Or _
setenta > 5 Or oitenta > 5 Or noventa > 5 Or cem > 5 Then
funVerificaPermitacao = False
Else
funVerificaPermitacao = True

End If

End Function
 
Back
Top