- 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
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