Gerador randomico

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

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

Assunto: 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

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

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.

Assunto: 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

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

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

Assunto: 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

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

Boa tarde

Meu caro alexandrevba, assunto liquidado, muito bom.

Obrigado pela ajuda

» Gerador de estatistica
» Gerador de código automático