Este fórum está sendo desativado

Depois de 9 anos, este fórum será desativado. Mas calma.... estamos migrando para uma comunidade no DISCORD. Junte-se a nós.

ENTRAR PARA DISCORD

Se você tem alguma dica, truque ou macete e gostaria de compartilhar conosco, utilize essa seção.
#25114
Saudações.
Como mencionei em minha apresentação, sou novo, tanto no fórum quanto na utilização do Excel.
Bem. Estou desenvolvendo uma planilha para analisar o jogo da Lotofácil, enquanto garimpava pela rede, me deparei com uma planilha onde é possível geral (a partir da: quantidade de dezenas informada para o jogo) e (quantidade de dezenas que se quer utilizar para as combinações), todas as combinações possíveis para um determinado tipo de jogo. Exemplo: Mega Sena, Quina, Lotofácil, etc.
O código é esse:

Public ss As String
Sub Combinações(Optional v As Variant) 'nome da macro é combinação setando a matriz v como variante
Dim n As Integer, m As Integer 'seta a quantidade elementos como número inteiro

n = Application.CountA(Range("A2:XFD2")) 'conta quantidade de números para gerar combinações
If IsMissing(v) Then 'v sendo ausente executa o redimensionamento da matriz na quantidade máxima de 1000 elementos
ReDim v(1000) As Variant
For i = 0 To n - 1 'inicia a captura dos números digitados para a matriz
v(i) = Cells(2, i + 1)
Next
End If
ReDim Preserve v(1 To n) 'redimensiona a matriz para a quantidade máxima de elementos digitados
m = [a4] 'alimente a variável m com a a quantidade de elementos em cada combinação
If m > n Then Exit Sub 'se o número de elementos para combinação for maior que a quantidade de elementos é encerrado a macro

If Application.Combin(n, m) > 100000 Then 'cálcula quantas combinações são possíveis e encerra a macro se foram maior que 100 mil
MsgBox "Serão mais de 100000 combinações, a programação será encerrada"
Exit Sub
End If
ss = "" 'variável ss serve para fazer a junção da combinação
Range("5:5").ClearContents 'seleciona o cabeçalho das combinações e apaga
For i = 1 To m
Cells(5, i) = "Nº " & i 'cria novos cabeçalhos com a quantidade exata dos elementos
Next
Cells(5, i) = "Junção"
Rows("6:1000006").ClearContents 'exclui dados antigos caso existam
Range("A6").Select 'marca a celula inicial que receberá os dados
Comb2 n, m, 1, "", v 'chama a macro Comb2 setando a algumas variáveis e mantendo outras
End Sub

Sub Comb2(ByVal n As Integer, ByVal m As Integer, _
ByVal k As Integer, ByVal s As String, v As Variant)
Dim v1 As Variant
If m > n - k + 1 Then Exit Sub 'se o número de elementos para combinação for maior que a quantidade de elementos é encerrado a macro
If m = 0 Then 'quando m for igual a 0 inicia a montagem das combinações
v1 = Split(Replace(Trim(s), "'", ""), " ") 'v1 armazena a posição que serão recuperados da matriz
sss = "" 'sss assim como ss são utilizadas para a junção dos números da combinação
For i = LBound(v1) To UBound(v1) 'loop da matriz v1 que possui o endereço do elemento da matriz v
sss = sss & v(v1(i)) & " " 'inicia a junção da combinação para apresentar na coluna Junção
ActiveCell.Offset(0, i) = v(v1(i)) 'imprime o primeiro número da combinação na célula A6 sendo incrementada a cada loop
Next
ActiveCell.Offset(0, [a4]) = sss 'imprime na coluna junção os número concatenados
ActiveCell.Offset(1, 0).Select 'seleciona um nova lina
ss = ss & sss & vbNewLine 'limpa conteúdo das variáveis ss e sss
Exit Sub
End If
Comb2 n, m - 1, k + 1, s & k & " ", v 'incrementa as variáveis m utilizada para dar start nas combinações e variável s que armazena o caminho dos elementos da matriz
Comb2 n, m, k + 1, s, v 'quando elimina cada bloco de combinação reinicia a Macro Comb2 até que m seja maior que n
End Sub

Tenho a planilha em meu arquivo, mas não sei como anexá-la aqui. Caso alguém tenha interesse, basta me dizer como e terei prazer em compartilha-la.
NILTON70 agradeceu por isso
#29200
Favor,
Você pode me enviar a planilha por e-mail? otavioalex@gmail.com
Obrigado.
Otavio


ronierobson escreveu:Saudações.
Como mencionei em minha apresentação, sou novo, tanto no fórum quanto na utilização do Excel.
Bem. Estou desenvolvendo uma planilha para analisar o jogo da Lotofácil, enquanto garimpava pela rede, me deparei com uma planilha onde é possível geral (a partir da: quantidade de dezenas informada para o jogo) e (quantidade de dezenas que se quer utilizar para as combinações), todas as combinações possíveis para um determinado tipo de jogo. Exemplo: Mega Sena, Quina, Lotofácil, etc.
O código é esse:

Public ss As String
Sub Combinações(Optional v As Variant) 'nome da macro é combinação setando a matriz v como variante
Dim n As Integer, m As Integer 'seta a quantidade elementos como número inteiro

n = Application.CountA(Range("A2:XFD2")) 'conta quantidade de números para gerar combinações
If IsMissing(v) Then 'v sendo ausente executa o redimensionamento da matriz na quantidade máxima de 1000 elementos
ReDim v(1000) As Variant
For i = 0 To n - 1 'inicia a captura dos números digitados para a matriz
v(i) = Cells(2, i + 1)
Next
End If
ReDim Preserve v(1 To n) 'redimensiona a matriz para a quantidade máxima de elementos digitados
m = [a4] 'alimente a variável m com a a quantidade de elementos em cada combinação
If m > n Then Exit Sub 'se o número de elementos para combinação for maior que a quantidade de elementos é encerrado a macro

If Application.Combin(n, m) > 100000 Then 'cálcula quantas combinações são possíveis e encerra a macro se foram maior que 100 mil
MsgBox "Serão mais de 100000 combinações, a programação será encerrada"
Exit Sub
End If
ss = "" 'variável ss serve para fazer a junção da combinação
Range("5:5").ClearContents 'seleciona o cabeçalho das combinações e apaga
For i = 1 To m
Cells(5, i) = "Nº " & i 'cria novos cabeçalhos com a quantidade exata dos elementos
Next
Cells(5, i) = "Junção"
Rows("6:1000006").ClearContents 'exclui dados antigos caso existam
Range("A6").Select 'marca a celula inicial que receberá os dados
Comb2 n, m, 1, "", v 'chama a macro Comb2 setando a algumas variáveis e mantendo outras
End Sub

Sub Comb2(ByVal n As Integer, ByVal m As Integer, _
ByVal k As Integer, ByVal s As String, v As Variant)
Dim v1 As Variant
If m > n - k + 1 Then Exit Sub 'se o número de elementos para combinação for maior que a quantidade de elementos é encerrado a macro
If m = 0 Then 'quando m for igual a 0 inicia a montagem das combinações
v1 = Split(Replace(Trim(s), "'", ""), " ") 'v1 armazena a posição que serão recuperados da matriz
sss = "" 'sss assim como ss são utilizadas para a junção dos números da combinação
For i = LBound(v1) To UBound(v1) 'loop da matriz v1 que possui o endereço do elemento da matriz v
sss = sss & v(v1(i)) & " " 'inicia a junção da combinação para apresentar na coluna Junção
ActiveCell.Offset(0, i) = v(v1(i)) 'imprime o primeiro número da combinação na célula A6 sendo incrementada a cada loop
Next
ActiveCell.Offset(0, [a4]) = sss 'imprime na coluna junção os número concatenados
ActiveCell.Offset(1, 0).Select 'seleciona um nova lina
ss = ss & sss & vbNewLine 'limpa conteúdo das variáveis ss e sss
Exit Sub
End If
Comb2 n, m - 1, k + 1, s & k & " ", v 'incrementa as variáveis m utilizada para dar start nas combinações e variável s que armazena o caminho dos elementos da matriz
Comb2 n, m, k + 1, s, v 'quando elimina cada bloco de combinação reinicia a Macro Comb2 até que m seja maior que n
End Sub

Tenho a planilha em meu arquivo, mas não sei como anexá-la aqui. Caso alguém tenha interesse, basta me dizer como e terei prazer em compartilha-la.
#54349
olicarlos escreveu:Você pode me enviar está planilha ?
Não é necessário. Faça direto na sua planilha.

1. copie os dois códigos do primeiro post
2. cole-os em um módulo comum ~~~> no Excel aperte Alt+F11 / menu Inserir / Módulo / cole na janela que irá se abrir
3. em uma planilha vazia coloque as dezenas que deseja combinar na linha 2, a partir de A2 e em A4 coloque a quantidade de dezenas a combinar
exemplo:
combinar 20 dezenas ~~~> coloque as 20 dezenas em A2:T2
quantidade de dezenas a combinar 6 ~~~> coloque o número 6 em A4

4. rode o código Combinações

Os resultados serão colocados pelo código a partir de A6.

Alternativa - Combinações online
https://planetcalc.com/3757/

=SE(MÊS(A1)<7;"1º sem&a[…]

Bom Dia Senhores. Tenho uma macro que preciso dei[…]

Free relationships without drama and obligations. […]

Girar Imagem e Zoom

Boa noite Teria alguma forma de dar um "[…]

Valeu. Muito Obrigado!!!!!!!!

Pessoal, Ao clicar no botão Copiar (Guia C[…]

Procv com serro em vba

Resolvido

Bom dia, pessoal! com a data de nascimento e data […]

Estamos migrando para uma comunidade no Discord