Fórum Excel Bácico, Avançado e Vba

Este fórum é destina a usuário de Excel, que queiram compartilhar informações a básicas, avançadas e programação em VBA...
 
InícioInício  FAQFAQ  BuscarBuscar  MembrosMembros  GruposGrupos  Registrar-seRegistrar-se  Login  

Compartilhe | 
 

 Gerador randomico

Ver o tópico anterior Ver o tópico seguinte Ir em baixo 
AutorMensagem
Xanel



Mensagens : 21
Data de inscrição : 22/10/2012

MensagemAssunto: Gerador randomico   Seg Out 22, 2012 6:22 pm

Boa tarde

Uso esse gerador para fins diversos e é muito bom, mas como fazer o sorteio acontecer em determinado intervalo e em ordem crescente, uma vez que sempre roda a partir do intervalo A2.


Sub Sorteio_de_Numeros()
Dim a, b, c(98)

s = 1
d = 8

For lin = 2 To s + 1
For a = 1 To 98
c(a) = a
Next

For a = 1 To d
b = 1 + Int(Rnd * (98 - b))
Cells(lin, a).Select
Cells(lin, a).Value = c(b)
c(b) = c(99 - b)
Next
Next
Range("D8").Select
End Sub


Agradeçe a ajuda
Voltar ao Topo Ir em baixo
Ver perfil do usuário
alexandrevba



Mensagens : 1820
Data de inscrição : 13/07/2011
Localização : Serra - ES

MensagemAssunto: Re: Gerador randomico   Qui Out 25, 2012 2:27 am

Boa noite!!

Isso deve resolver!
Código:
Sub AleVBA()
With Range("A2:A9")
    .Formula = "=INT(99*RAND()+1)"
    .Value = .Value
End With
End Sub
Voltar ao Topo Ir em baixo
Ver perfil do usuário
Xanel



Mensagens : 21
Data de inscrição : 22/10/2012

MensagemAssunto: Re: Gerador randomico   Qui Out 25, 2012 4:16 am

Boa noite

Muito bom o código mas queria relatar que ele gera numeros repetidos e não oraganiza os numeros em ordem crescente. Se pudesse corrigir eu agradeceria.
Voltar ao Topo Ir em baixo
Ver perfil do usuário
alexandrevba



Mensagens : 1820
Data de inscrição : 13/07/2011
Localização : Serra - ES

MensagemAssunto: Re: Gerador randomico   Qui Nov 01, 2012 5:18 pm

Boa tarde!!

Faça os teste...
Código:
Sub AleNumeros()
   
    Dim lng As Long
    Dim var As Variant
    With CreateObject("Scripting.Dictionary")
        Do While .Count <= Range("A2:A9").Cells.Count
            lng = Rnd * 99 + 1
            .Item(lng) = Empty
        Loop
        var = Application.Transpose(.Keys)
        SortIntegerArray var
        Range("A2:A9").Value = var
    End With
   
End Sub
Sub SortIntegerArray(ByRef paintArray As Variant)
    Dim lngX As Long
    Dim lngY As Long
    Dim intTemp
   
    For lngX = LBound(paintArray) To (UBound(paintArray) - 1)
        For lngY = LBound(paintArray) To (UBound(paintArray) - 1)
            If Val(paintArray(lngY, 1)) > Val(paintArray(lngY + 1, 1)) Then
                'exchange the items
                intTemp = paintArray(lngY, 1)
                paintArray(lngY, 1) = paintArray(lngY + 1, 1)
                paintArray(lngY + 1, 1) = intTemp
            End If
        Next
    Next
End Sub


Última edição por alexandrevba em Sex Nov 02, 2012 1:11 pm, editado 1 vez(es)
Voltar ao Topo Ir em baixo
Ver perfil do usuário
Xanel



Mensagens : 21
Data de inscrição : 22/10/2012

MensagemAssunto: Re: Gerador randomico   Sex Nov 02, 2012 1:09 pm

Bom dia

Essa macro é boa, fiz alguns testes para mudar o intervalo: Range("A2:A9").Value = var, para A2:I2, para mas não deu certo. Onde mais posso alterar?

Agradecido pela ajuda
Voltar ao Topo Ir em baixo
Ver perfil do usuário
alexandrevba



Mensagens : 1820
Data de inscrição : 13/07/2011
Localização : Serra - ES

MensagemAssunto: Re: Gerador randomico   Sex Nov 02, 2012 10:25 pm

Boa tarde!!

Código:
Sub AleVBAaleatorionumero()
   
    Dim lng As Long
    Dim var As Variant
    Dim rng As Range
    Set rng = Range("A2:I2")
    With CreateObject("Scripting.Dictionary")
        Do While .Count <= rng.Cells.Count
            lng = Rnd * 99 + 1
            .Item(lng) = Empty
        Loop
        var = Application.Transpose(.Keys)
        SortIntegerArray var
        If rng.Columns.Count = 1 Then
            rng.Value = var
        ElseIf rng.Rows.Count = 1 Then
            rng.Value = Application.Transpose(var)
        End If
    End With
   
End Sub
Sub SortIntegerArray(ByRef paintArray As Variant)
    Dim lngX As Long
    Dim lngY As Long
    Dim intTemp
   
    For lngX = LBound(paintArray) To (UBound(paintArray) - 1)
        For lngY = LBound(paintArray) To (UBound(paintArray) - 1)
            If Val(paintArray(lngY, 1)) > Val(paintArray(lngY + 1, 1)) Then
                'exchange the items
                intTemp = paintArray(lngY, 1)
                paintArray(lngY, 1) = paintArray(lngY + 1, 1)
                paintArray(lngY + 1, 1) = intTemp
            End If
        Next
    Next
End Sub
Voltar ao Topo Ir em baixo
Ver perfil do usuário
Xanel



Mensagens : 21
Data de inscrição : 22/10/2012

MensagemAssunto: Re: Gerador randomico   Sex Nov 02, 2012 11:55 pm

Boa tarde

Meu caro alexandrevba, assunto liquidado, muito bom.

Obrigado pela ajuda
Voltar ao Topo Ir em baixo
Ver perfil do usuário
Conteúdo patrocinado




MensagemAssunto: Re: Gerador randomico   Hoje à(s) 10:13 pm

Voltar ao Topo Ir em baixo
 
Gerador randomico
Ver o tópico anterior Ver o tópico seguinte Voltar ao Topo 
Página 1 de 1
 Tópicos similares
-
» Erro em gerador randômico
» script gerador de campo de visão
» Gerador de Skeletons 3ª Versão
» [Resolvido]como faze objeto randomico
» [Resolvido] Gerador de mensagens

Permissão deste fórum:Você não pode responder aos tópicos neste fórum
Fórum Excel Bácico, Avançado e Vba :: Avançado/VBA :: Excel Avançado/VBA-
Ir para: