Embaralhador de celulas

Planilhas, Arquivos, modelos, exemplos, apostilas, nosso datacenter!

Embaralhador de celulas

Mensagempor edcronos2 » Sex Abr 01, 2016 12:49 am

embaralhador de celulas

eu sempre gosto de fazer macros estranhas, que podem ou não servir para alguem , mas e daí?

é uma versão simplificada da que eu fiz,
para falar a verdade eu tinha feito uma macro que pegava de uma range e ia montando grupos tipo de x celulas escolhendo valores aleatoriamente da range de origem,
então apenas exclui os extras e coloquei para embaralhar "ou quase" a range selecionada
Código: Selecionar todos
Sub Embaralha_seleção()
    Dim numm()
    numm = Selection
    ct = UBound(numm, 2)
    lt = UBound(numm, 1)
    ReDim dex(1 To lt * ct)
    n = 0
    For h = 1 To ct
        For v = 1 To lt
            If numm(v, h) & " " <> " " Then
                n = n + 1
                dex(n) = numm(v, h)
                numm(v, h) = ""
            End If
        Next
    Next
    t = 1
    For h = 1 To ct
        For v = 1 To lt
volta:
            Randomize
            vvv = Int((n * Rnd) + 1)
            If dex(vvv) = "" And t <= n Then
                GoTo volta
            Else
                t = t + 1
                numm(v, h) = dex(vvv)
                dex(vvv) = ""
            End If
        Next
    Next
    Selection = numm
End Sub


For this post the author edcronos2 thanked:
prlima (Seg Abr 22, 2019 7:50 pm)
edcronos2
Membro
Membro
 
Mensagens: 467
Registrado em: Seg Nov 30, 2015 6:59 pm
Has thanked: 28 times
Have thanks: 101 times

{ SO_SELECT }

Re: Embaralhador de celulas

Mensagempor edcronos2 » Sex Abr 01, 2016 12:57 am

esse cria sequencias de escolhas aleatórias de uma range
tanto a de cima como essa exclui celulas vazias das escolhas

Código: Selecionar todos
Sub Escolha_aleatoria()
    Dim numm()
    dmx = 5    ' quantidade de celulas por grupo
    l = 11    'linha inicial do grupo de saida


    numm = Range("b3:U8")    'rangue que contem as celulas para randomizar escolha
    ct = UBound(numm, 2)
    lt = UBound(numm, 1)
    ReDim dex(1 To lt * ct)
    n = 0
    For h = 1 To ct
        For v = 1 To lt
            If numm(v, h) & " " <> " " Then
                n = n + 1
                dex(n) = numm(v, h)
            End If
        Next
    Next

    If n < dmx Then
        MsgBox "dezenas insuficientes para preencher grupo"
        Exit Sub
    End If
    t = 1
voltas:
    ReDim numm(1 To 1, 1 To dmx)
    For d = 1 To dmx
volta:
        Randomize
        vvv = Int((n * Rnd) + 1)
        If dex(vvv) = "" And t <= n Then
            GoTo volta
        Else
            t = t + 1
            numm(1, d) = dex(vvv)
            dex(vvv) = ""
        End If

    Next
    Range("A" & l, Cells(l, dmx)) = numm
    If t > n Then Exit Sub
    l = l + 1
    For h = 1 To n
        If dex(h) <> "" Then GoTo voltas
    Next
End Sub

For this post the author edcronos2 thanked:
prlima (Seg Abr 22, 2019 7:50 pm)
edcronos2
Membro
Membro
 
Mensagens: 467
Registrado em: Seg Nov 30, 2015 6:59 pm
Has thanked: 28 times
Have thanks: 101 times

Re: Embaralhador de celulas

Mensagempor edcronos2 » Sex Abr 01, 2016 9:52 am

uma planilha de exemplo da segunda macro
edcronos2
Membro
Membro
 
Mensagens: 467
Registrado em: Seg Nov 30, 2015 6:59 pm
Has thanked: 28 times
Have thanks: 101 times

Re: Embaralhador de celulas

Mensagempor prlima » Seg Abr 22, 2019 7:26 pm

Boa noite amigo, estou precisando montar um embaralhador de questões de prova, e esse seu código é bem parecido com que eu preciso, as provas terão em média 10 questões, sendo 4 alternativas por questão, então o que preciso é embaralhar as sequencias não só das 10 questões mas também das alternativas (claro, cada alternativa dentro de sua questão de origem). Será que você poderia adaptar o código para esse fim?
A prova vem pronta de um outro orgão, por isso precisamos embaralhar e criar 3 tipos de provas diferentes, mas com as mesmas questões, ou seja, apenas embaralhar mesmo. (com o código fazendo o embaralhamento dos números, vou usar o procv para relaciona-los com as questões).
Fico muito grato se puder me ajudar com isso.
prlima
Membro
Membro
 
Mensagens: 1
Registrado em: Seg Abr 22, 2019 6:34 pm
Has thanked: 3 times
Have thanks: 0 time

Re: Embaralhador de celulas

Mensagempor JSCOPA » Seg Abr 22, 2019 9:23 pm

.
prlima, como pedem as regras do fórum, e para agilizar sua resposta, sugiro postar um arquivo exemplo - de como está e como você gostaria que ficasse!!
.
PS: como a Biblioteca não foi feita para perguntas, mas somente para soluções paradgma, o ideal seria você criar um tópico aqui (viewforum.php?f=10) e fazer menção ao tópico do edcronos2 !!
.
PS2: como você parece ser professor, talvez isto te interesse também https://www.ufpe.br/widget/agencia/noticias?p_p_id=101&p_p_lifecycle=0&p_p_state=maximized&_101_struts_action=%2Fasset_publisher%2Fview_content&_101_assetEntryId=810643&_101_type=content&_101_groupId=40615&_101_urlTitle=aplicativo-criado-por-professor-da-ufpe-otimiza-a-correcao-de-provas&inheritRedirect=true
.
JSCOPA
 

Re: Embaralhador de celulas

Mensagempor edcronos2 » Seg Abr 22, 2019 9:57 pm

@prlima
é muito facil v modificar para a range que tem suas questões
no caso a primeira macro

no inicio tem essa linha
numm = Selection

coloque assim
numm = range("a1:a10")

e no final dela tem essa linha
Selection = numm

coloque assim
range("a1:a10") = numm

a1:a10 é as celulas que estão suas questões
edcronos2
Membro
Membro
 
Mensagens: 467
Registrado em: Seg Nov 30, 2015 6:59 pm
Has thanked: 28 times
Have thanks: 101 times

Re: Embaralhador de celulas

Mensagempor JSCOPA » Seg Abr 22, 2019 10:51 pm

.
edcronos2, gostei do seu código!! ... Mas pelo que entendi ele quer mais que isto ... ou seja, que embaralhe as perguntas e, também/depois, as respostas!!
.
JSCOPA
 

Re: Embaralhador de celulas

Mensagempor edcronos2 » Seg Abr 22, 2019 11:41 pm

JSCOPA
bem nada impede dele repetir a macro com outro nome e colocar para outra range das resposta
até mesmo transformar a macro em função e chamar com uma macro com as range que pretende embaralhar
mas como vc falou fica dificil adaptar sem saber como tá a planilha dele
edcronos2
Membro
Membro
 
Mensagens: 467
Registrado em: Seg Nov 30, 2015 6:59 pm
Has thanked: 28 times
Have thanks: 101 times


Voltar para Biblioteca

Quem está online

Usuários navegando neste fórum: Nenhum usuário registrado e 1 visitante