Lista aleatória

2024 - VBA & Macros

Post Recente por AdLuque 8 anos atrás

4 Posts

4 Usuários

0 Reactions

1,004 Visualizações

RSS

nosbier

(@nosbier)

Posts: 26

Trusted Member

Topic starter

Boa tarde.
Estou querendo uma planilha que seja aleatória, ou seja, que mude constantemente. Explico.
Sou professor, e queria distribuir a sala de aula em dia de provas em 3 e 4 fileiras, encontrei uma planilha na internet e achei bem interessante, porém os dados estão dispostos em uma única coluna. Como faço para dispor essa planilha em 3 e 4 colunas?

O código ao qual me refiro é:

Sub Sorteio()
    Dim Vetor()
    Dim Qt As Long
    Dim i As Long
    Dim n As Long
    Dim Max As Long
      
    Columns("A").Clear
    Qt = [C1].Value
    Max = [C2].Value
    If Qt > Max Then
        MsgBox "O valor da célula C1 não pode ser maior que o da célula C2!"
        Exit Sub
    End If
    ReDim Vetor(Max)
    For i = 1 To Max
        Vetor(i) = i
    Next
    
    For i = 1 To Qt
        n = Int(Rnd * (Max - i + 1)) + 1
        Vetor(0) = Vetor(n + i - 1)
        Vetor(n + i - 1) = Vetor(i)
        Vetor(i) = Vetor(0)
        Cells(i, 1).Value = Vetor(i)
    Next
End Sub

Postado : 20/04/2016 12:55 pm

Basole

(@basole)

Posts: 487

Reputable Member

nosbier,
Adaptei o seu codigo.
Veja o anexo, se é isso que esta querendo:

Sorteio-Basole.zip

Click em se a resposta foi util!

Postado : 20/04/2016 2:36 pm

fitolab

(@fitolab)

Posts: 1

New Member

Excelente, Basole.
Estou tentando adaptar sem repetir os números dentro de cada fila!
Ou seja, preciso que os numeros de cada fileira não repitam.
@gmail.com">***@gmail.com (Para tua segurança não é permitido postar endereço de e-mail)

Sub Sorteio()
    Dim Vetor()
    Dim Qt As Long
    Dim i As Long
    Dim n As Long
    Dim Max As Long
      With ActiveSheet
    .Columns("A:D").Clear
    Qt = .[H1].Value
    Max = .[H2].Value
    If Qt > Max Then
        MsgBox "O valor da célula H1 não pode ser maior que o da célula C2!"
        Exit Sub
    End If
       If [H3].Value = "" Then MsgBox "Insira a Qtd de Filas na celula [ H3] ": Exit Sub
    ReDim Vetor(Max)
    For i = 1 To Max
        Vetor(i) = i
    Next
   
    For i = 1 To Qt
       For j = 1 To .[H3].Value
       n = Int(Rnd * (Max - i + 1)) + 1
        Vetor(0) = Vetor(n + i - 1)
        Vetor(n + i - 1) = Vetor(i)
        Vetor(i) = Vetor(0)
        .Cells(i, j).Value = Vetor(i)
        Next
    Next
    End With
End Sub

Postado : 17/12/2016 9:16 pm

AdLuque

(@adluque)

Posts: 1

New Member

Pessoal boa tarde,

É possivel fazer com que o Excel faça o sorteio dentro de um conjunto de números?
No exemplo feito em VBA o excel busca numeros dentro do maximo estipulado, porem não foi colocado um minimo então ele sempre parte do 1,
Gostaria de fazer estes mesmos sorteios, porem buscando numeros entre 10 a 30 por exemplo.

Então eu deveria adicionar uma linha de comando com um numero minimo, para a busca alguem pode ajudar?

Abs.

Adriano Luque

Postado : 21/04/2017 9:58 am