Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Lista aleatória
 
Notifications
Clear all

Lista aleatória

 
2024 - VBA & Macros
Post Recente por AdLuque 7 anos atrás
4 Posts
4 Usuários
0 Reactions
996 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
(@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
Forum Jump:
  Tópico Anterior
Próximo Tópico