Embaralhador de celulas ou valores

[Guest Zangado]

tem uma planilha da segunda macro

http://www.planilhando.com.br/forum/viewtopic.php?f=21&t=19745

 

embaralha area selecionada

    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

 

 

cria grupos

    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

 

Edited April 1, 2016 by Zangado
adinicionar informação