rotina quebra cabeça, ou permutação sequencial

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

rotina quebra cabeça, ou permutação sequencial

Mensagempor edcronos2 » Sex Ago 05, 2016 4:23 pm

estava querendo fazer uma permutação sequencial de um jeito diferente
claro que complica um bocado ainda mais sendo eu fazendo
parece estar funcionando
Código: Selecionar todos

Sub sequencial4()
Dim Qd As Long, Vx As Long, vv As Long, C As Long, L As Long, Qd2 As Long, Cc As Long ', vv As Long
    vm = 1  '-----(Valor mínimo
    Vx = 50 '-----(valor máximo
    Qd = 5 '-----(Quantidade de dezenas por )
    li = 2 '-----(Linha inicial
    ci = 1 '-----(Coluna inicial
    lf = 300000 '-----(linhas "quase limite"

   '------------------------------------------------------
    L = 1
    Qd2 = Qd - 1
    ReDim seq(1 To lf + 100, 1 To Qd)
    ReDim vm2(1 To Qd) As Byte
    For C = 1 To Qd
        vm2(C) = vm + C - 1
    Next
volt:
    For vv = vm2(Qd) To Vx
        seq(L, Qd) = vv
        For C = 1 To Qd2
            seq(L, C) = vm2(C)
        Next
        L = L + 1
    Next
        vm2(Qd2) = vm2(Qd2) + 1
        vm2(Qd) = vm2(Qd2) + 1 '<<<errata
    For C = Qd2 To 2 Step -1
         If vm2(C) <= Vx - (Qd - C) Then GoTo ddsd
         vm2(C - 1) = vm2(C - 1) + 1
        For Cc = C To Qd
         vm2(Cc) = vm2(Cc - 1) + 1
        Next
    Next

ddsd:
    If L >= lf Then
        Range(Cells(li, ci), Cells(li + L - 2, ci + Qd - 1)).Value2 = seq
        ci = ci + Qd + 1
        L = 1
    End If
    If vm2(1) <= Vx - (Qd - Qd2) Then GoTo volt
    Range(Cells(li, ci), Cells(li + L - 2, ci + Qd - 1)).Value2 = seq

End Sub

só cuidado com o tamanho da sequencia
edcronos2
Membro
Membro
 
Mensagens: 464
Registrado em: Seg Nov 30, 2015 6:59 pm
Has thanked: 28 times
Have thanks: 102 times

{ SO_SELECT }

Voltar para Biblioteca

Quem está online

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