Lomeutec - Tutoriais e Informação
Publicidade: Powered by Hotwords

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.
 
 
 
 
Política de Comentários Política de Parcerias Política de Privacidade Política de uso