Guest Zangado Posted August 5, 2016 Share Posted August 5, 2016 (edited) macro para permutação sequencial o codigo é um tanto que bagunçado kkkk, eu acho que está funcionando bem 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 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 Edited August 5, 2016 by Zangado Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.