Lomeutec - Tutoriais e Informação

Números aleatórios sem repetições no Excel

Publicidade: Powered by Google

Não se importa em contar inteiramente com a sorte, mas mesmo assim está sem um palpite para jogar na Mega Sena? Então deixe o Excel sugerir alguns números. Vou mostrar uma rotina em VBA para fazer com que o Excel crie a quantidade de números aleatórios sem repetições que você queira e dentro da faixa de sua escolha.

Excel

Na verdade, essa rotina em VBA cria a quantidade de números aleatórios que você escolher dentro da faixa que você determinar. Ou seja, não é necessariamente somente para gerar números para a Mega Sena, pode ser para qualquer loteria ou qualquer outra aplicação onde seja necessário gerar números aleatórios.

A rotina é esta que está abaixo:

Sub Sortear()
    Dim V() 'Vetor
    Dim CONT As Integer 'Contador
    Dim I As Integer 'Índice do vetor
    Dim QUANT_SORT As Integer 'Recebe o valor de quantos Nº aleatórios serão gerados
    Dim NUM_SORT As Integer 'Recebe um número sorteado
    Dim LIN As Integer 'Determina em que linha o Nº aleatório será colocado
    Dim REP As Integer 'Repetidor
    Dim VAL_MIN As Integer 'Recebe o valor mínimo na faixa de números
    Dim VAL_MAX As Integer 'Recebe o Valor máximo na faixa de números
    Dim FAIXA_SORT As Integer 'Faixa de valores possíveis ao sorteio
   
ActiveSheet.Name = "lomeutec.blogspot.com"
Plan2.Name = "Lomeutec"
Plan3.Name = "Tutoriais e Informação"
On Error GoTo SAIDA
[B1:B65536].ClearContents
Range("B1:B65536").Font.Bold = True
Range("B1:B65536").Font.Size = 12
INICIO:

    VAL_MIN = InputBox("Qual será o MENOR número possível nesse sorteio?", "Lomeutec - Tutoriais e Informação ")
    VAL_MAX = InputBox("Qual será o MAIOR número possível desse sorteio?", "Lomeutec - Tutoriais e Informação ")
   
CHECA_VALOR_MAX:
   
    If VAL_MAX <= VAL_MIN Then
       If MsgBox("Você deve digitar um número MAIOR para o valor máximo ou alterar o valor mínimo. O Valor mínimo atual é " & VAL_MIN & ". Deseja Alterará-lo?", vbQuestion + vbYesNo + vbApplicationModal + vbDefaultButton1, "Lomeutec - Tutoriais e Informação") = vbYes Then
           VAL_MIN = InputBox("Corrija o valor mínimo para o sorteio.", "Lomeutec - Tutoriais e Informação ")
              If VAL_MAX <= VAL_MIN Then
                GoTo CHECA_VALOR_MAX
              End If
       Else
           VAL_MAX = InputBox("Nesse caso digite um valor MAIOR que " & VAL_MIN & ". O valor máximo atual é " & VAL_MAX & ".", "Lomeutec - Tutoriais e Informação ")
              If VAL_MAX <= VAL_MIN Then
                GoTo CHECA_VALOR_MAX
              End If
       End If
    End If
               
FAIXA_SORT = VAL_MAX - VAL_MIN + 1
     
    QUANT_SORT = InputBox("Quantos números você deseja sortear?", "Lomeutec - Tutoriais e Informação ")
   
CHECA_FAIXA:
   
       If QUANT_SORT > FAIXA_SORT Then
          QUANT_SORT = InputBox("A quantidade de sorteios supera o valor máximo de números possíveis a serem sorteados sem repetições. Por favor corrija para um número MENOR ou IGUAl a " & FAIXA_SORT & ".", "Lomeutec - Tutoriais e Informação ")
          GoTo CHECA_FAIXA
       End If
     
       If VAL_MAX = VAL_MIN + 1 Then
            If MsgBox("Você determinou uma faixa muito estreita para a realização de um sorteio. Deseja Alterar os dados?", vbExclamation + vbYesNo + vbApplicationModal + vbDefaultButton1, "Lomeutec - Tutoriais e Informação") = vbYes Then
                GoTo INICIO
            Else
                MsgBox "Não é possível realizar um sorteio com os números dados.", vbOKOnly + vbApplicationModal + vbCritical, "Lomeutec - Tutoriais e Informação"
                GoTo SAIDA
            End If
       End If
     
    Randomize
    For LIN = 1 To QUANT_SORT
        I = I + 1
        ReDim Preserve V(I)
REPETE:
        NUM_SORT = Int(Rnd * VAL_MAX + VAL_MIN)
        REP = 0
        For CONT = I - LIN To I
            If NUM_SORT = V(CONT) Or NUM_SORT > VAL_MAX Then
                REP = 1
            End If
        Next
        If REP = 1 Then
            GoTo REPETE
        Else
            V(I) = NUM_SORT
        End If
    Next
    I = 0
    For LIN = 1 To QUANT_SORT
        I = I + 1
        Cells(LIN, 2) = V(I)
    Next LIN
SAIDA:
End Sub

É uma rotina baseada em outra disponibilizada no Yahoo Groups .

Excel 2003:

Se você usa o Excel 2003 deverá fazer da seguinte forma. Depois de abrir uma nova planílha, vá ao menu "Ferramentas", depois em "Macro" e clique em "Editor do "Visual Basic".


Clique no ícone "Project Explorer", depois dê um duplo clique em "Plan1(Plan1)" e irá surgir uma área branca no lado direito onde você deverá colar a rotina.


Já pode fechar essa janela e assim estará de volta a planílha.  Agora clique no menu "Exibir", depois em 'Barra de ferramentas" e por fim em "Formulários".

Aparecerá uma caixa de controles flutuantes. Clique no controle "Botão"  dessa barra de ferramentas flutuante e crie um botão em uma área qualquer da planílha.


Daí selecione "Plan1.Sortear" e confirme em "OK". Feito isso você poderá personalizar o botão. Altere o texto do botão, o seu tamanho e corrija a posição dele para o lugar que quiser. Sempre que quiser selecionar o botão para editá-lo sem acioná-lo, deverá segurar a tecla "CTRL". A barra de formulários não é mais necessária, se quiser pode fechá-la.

Agora vá ao menu 'Ferramentas" e clique em "Opções". Na guia "Segurança" clique no botão "Segurança de macro..." e Deixe selecionada a opção "Médio". Dessa forma, sempre que uma planílha tiver uma macro, será perguntado se você deseja ou não permiti-la.

Se deixássemos com a configuração padrão, a macro seria bloqueada e o código não conseguiria gerar os números aleatórios. Salve e está pronto. Quando reabrir o arquivo, será feita uma pergunta sobre habilitar ou não macros. Escolha "Habilitar Macros".

Teste para ver como funciona.

Excel 2010:

Apresentarei apenas as diferenças nos procedimentos entre as versões 2003 e 2010 do Excel que poderia causar alguma dúvida. Sendo assim, mesmo que você não possua a versão 2003 do Excel, leia toda a publicação. Só assim você entenderá corretamente o que deve ser feito, pois alguns procedimentos aplicados são comuns às duas versões.

No Excel 2010 você terá que habilitar a guia "Desenvolvedor". Para isso vá a guia "Arquivo" e clique em "Opções". Feito isso, clique em "Personalizar faixa de opções" e selecione a checkbox "Desenvolvedor".

Confirme e a guia desenvolvedor estará disponível. Clique nela e depois no botão "Visual Basic". Será o primeiro botão da esquerda para a direita.

Você irá colar o código da rotina da mesma forma que é feito no Excel 2003 como está explicado mais acima nessa publicação.

Voltando à planílha e ainda na guia "Desenvolvedor", clique no botão "Inserir" para achar os mesmos controles disponíveis na barra de ferramenta de formulários do Excel 2003.


Daí é só inserir e personalizar o botão como também já foi explicado. O que difere a partir deste ponto é a forma como você irá salvar essa planílha. Se você salvá-la de maneira usual, irá perder todo o trabalho que fez. Para salvar planílhas com macros no Excel 2010, você deve ir a guia "Arquivo", clicar em "Salvar como" e em "Tipo" escolher a opção "Pasta de Trabalho Habilitada para Macro do Excel (*.xlsm)"


Assim, da próxima vez em que você for abrir essa planílha, irá aparecer uma barra amarela com um botão para habilitar a macro, você deverá clicar nele para que a rotina funcione. Clique no botão, forneça os dados que a rotina vai pedindo e faça o teste. Os resultados serão apresentados na coluna "B" da planílha.


Se a planílha gerar os números premiados, lembre-se de que pegou essa dica aqui. :-)

Abraços e boa sorte.

Nilton (LOMEUTEC)
É formado como técnico em informática com ênfase em análise de sistemas e programação comercial. No entanto gosta mesmo é de fazer publicações para o blog lomeutec.com onde compartilha grande parte do pouco conhecimento autodidata que adquire através de experiências, estudos diários e até mesmo de tudo aquilo que descobre enquanto navega despreocupadamente pela internet em seus momentos de ócio. Aqui no LTI acumula funções de publicador, moderador, editor, administrador e o que mais for possível e necessário.

COMENTÁRIOS NÃO SÃO MAIS RESPONDIDOS DESDE AGOSTO DE 2013.

Se seu comentário não foi aprovado veja porque nas POLÍTICAS DE COMENTÁRIOS.
 
 
 
Política de Comentários Política de Parcerias Política de Privacidade Política de uso