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.