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 estar que vão gerar e ordenar os numeros.

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.