Gerador de chaves euromilhões no Excel através de um função em VBA.
Um gerador de chaves aleatórias para o Euromilhões e também para o Totoloto, a função serve para qualquer concurso que necessite de gerar números aleatórios, basta que lhe dê os parâmetros necessários para ela funcionar, neste caso é o numero de números a gerar.
Não há qualquer lógica nos números gerados, são completamente aleatórios.
Gerador de chaves euromilhões no excel
As funções estão documentadas, permitindo facilmente saber o que fazem, mais abaixo tem um video que mostra os passos a dar para fazer este gerador de números para euromilhões e totoloto.
Coloque num modulo as macros abaixo, este primeiro conjunto são as principais, são estas que vão gerar e ordenar os números.
Option Explicit
'----------------------------------------------
' Função auxiliar - Ordenar Chave
'----------------------------------------------
Function OrdenarArray(s As Variant) As Variant
Dim i As Integer, j As Integer, Tmp As Integer
For i = LBound(s) To UBound(s)
For j = i + 1 To UBound(s)
If s(i) > s(j) Then
Tmp = s(j): s(j) = s(i): s(i) = Tmp
End If
Next j
Next i
OrdenarArray = s
End Function
'----------------------------------------------
' Sorteio de numeros
'----------------------------------------------
Function Sortear( _
nQtd As Integer, _
nMinimo As Integer, _
nMaximo As Integer, _
Optional celulaInicial As Range, _
Optional Ordenar As Boolean _
) As Variant
Dim n As Integer, i As Integer, x As Integer
Dim arrayNumerosTmp
ReDim arrayNumeros(nQtd) As Variant
For i = 1 To nQtd
Do
Randomize
'Numero aleatorio
n = Int((nMaximo - nMinimo + 1) * Rnd + nMinimo)
'Verificar se o numero já existe
Loop Until (UBound(Filter(arrayNumeros, n)) > -1) = FALSE
'Coleccionar numero sem repetições
arrayNumeros(i) = n
Next i
' por predefinição chave não ordenada
arrayNumerosTmp = arrayNumeros
'caso haja um pedido para ordenar, ordena no sentido ASC
If (Ordenar = True) Then arrayNumerosTmp = OrdenarArray(arrayNumeros)
'No caso de haver uma localização inicial distribui os numeros
' na horizontal tendo como ponto de partida essa celula inicial
If Not IsEmpty(celulaInicial.Address) Then
For i = LBound(arrayNumerosTmp) To UBound(arrayNumerosTmp)
n = arrayNumerosTmp(i)
'simula uma contagem corrida do 1 ao numero desejado
For x = 1 To n
celulaInicial.Offset(0, i - 1).Value = x
Next x
Next i
End If
'Em todo o caso poderemos querer usar o resultado
Sortear = arrayNumerosTmp
End Function
Como Usar:
A função acima para funcionar precisa de alguns parametros, o intervalo de numeros e a quantidade a gerar são obrigatórios, no caso do euromilhões são 5 numeros entre o 1 e o 50 e 2 numeros entre o 1 e o 12 para as estrelas (alterado para as novas regras a partir do concurso de 27/09/2016).
Exemplo de linhas para o Euromilhões e Totoloto
Sub chave_Euromilhoes()
Dim nBolas
With Folha1
'Limpar área do jogo
.Range("C3:G5").ClearContents
'Identificar jogo
.Range("C3").Value = "EUROMILHÕES"
'Sortear 5 numeros entre o 1 e 50
nBolas = Sortear(5, 1, 50, .Range("C4"), True)
' Sortear 2 numeros entre o 1 e 12 (alterado para as novas regras de 27/09/2016)
nBolas = Sortear(2, 1, 12, .Range("D5"), True)
End With
End Sub
Sub chave_Totoloto()
Dim nBolas
With Folha1
'Limpar área do jogo
.Range("C3:G5").ClearContents
'Identificar jogo
.Range("C3").Value = "TOTOLOTO"
'Sortear 5 numeros entre o 1 e 49
nBolas = Sortear(5, 1, 49, .Range("C4"), True)
'Sortear 1 numeros entre o 1 e 13
nBolas = Sortear(1, 1, 13, .Range("E5"), True)
End With
End Sub
Tem dúvidas? Veja este video que mostra como deve fazer o gerador de numeros.