Excel combinações sem repetir os nomes

eliarde3 · 30 de junho de 2023

Estou tentando fazer um gerador de combinações que não se repitam , é fiquem em ordem .Consegui fazer com seis algarismo e queria fazer com dez ou até 13 algarismos com duas combinações cada algarismo ( COMBIN(26;2) = 325 ) embaixo vou deixar embaixo como tentei fazer e a fórmulas que estou tentando é a foto do modo que a planilha fica os nomes

Sub CombSeparado()



Application.ScreenUpdating = False 'Desabilita atualização de tela

'Application.Visible = False 'Fecha tela



Dim a(), b(), c(), d(), e(), f(), g(), h(), i(), j()



a = Range("A2:A" & Range("A1048576").End(xlUp).Row)

b = Range("B2:B" & Range("B1048576").End(xlUp).Row)

c = Range("C2:C" & Range("C1048576").End(xlUp).Row)

d = Range("D2:D" & Range("D1048576").End(xlUp).Row)

e = Range("E2:E" & Range("E1048576").End(xlUp).Row)

f = Range("F2:F" & Range("F1048576").End(xlUp).Row)

g = Range("G2:G" & Range("G1048576").End(xlUp).Row)

h = Range("H2:H" & Range("H1048576").End(xlUp).Row)

i = Range("I2:I" & Range("I1048576").End(xlUp).Row)

j = Range("J2:J" & Range("J1048576").End(xlUp).Row)







z = WorksheetFunction.Sum((Range("11234567890").End(xlUp).Row * Range("I11234567890).End(xlUp).Row * (Range("H11234567890").End(xlUp).Row * Range("G11234567890").End(xlUp).Row * V(Range("F11234567890").End(xlUp).Row * Range("E11234567890").End(xlUp).Row * Range("D11234567890").End(xlUp).Row * Range("C11234567890").End(xlUp).Row * Range("B11234567890").End(xlUp).Row) * Range("A11234567890

").End(xlUp).Row)

y = 2

 While y <= z

For v = 1 To UBound(b)

For m = 1 To UBound(a)

For n = 1 To UBound(c)

For o = 1 To UBound(d)

For p = 1 To UBound(e)

For q = 1 To UBound(f)

For r = 1 To UBound(g)

For s = 1 To UBound(h)

For t = 1 To UBound(i)

For u = 1 To UBound(j)





    Cells(y, 11).Value = a(m, 1)

    Cells(y, 12).Value = b(v, 1)

    Cells(y, 13).Value = c(n, 1)

    Cells(y, 14).Value = d(o, 1)

    Cells(y, 15).Value = e(p, 1)

    Cells(y, 16).Value = f(q, 1)

    Cells(y, 17).Value = g(r, 1)

    Cells(y, 18).Value = h(s, 1)

    Cells(y, 19).Value = i(t, 1)

    Cells(y, 20).Value = j(u, 1)

   

    y = y + 1

    Next m

    Next n

    Next o

    Next p

    Next q

    Next r

    Next s

    Next t

    Next u

    Next v

   Wend

   ActiveSheet.Range("20:V1048576").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)

   

   

Application.ScreenUpdating = True 'Desabilita atualização de tela

'Application.Visible = False 'Fecha tela

End Sub

combinações Estudo.xlsx

Essa foi a fórmula que usei para fazer com seis algarismo

Sub CombSeparado()



Application.ScreenUpdating = False 'Desabilita atualização de tela

'Application.Visible = False 'Fecha tela



Dim a(), b(), c(), d(), e(), f(), z



a = Range("A2:A" & Range("A1048576").End(xlUp).Row)

b = Range("B2:B" & Range("B1048576").End(xlUp).Row)

c = Range("C2:C" & Range("C1048576").End(xlUp).Row)

d = Range("D2:D" & Range("C1048576").End(xlUp).Row)

e = Range("E2:E" & Range("C1048576").End(xlUp).Row)

f = Range("F2:F" & Range("C1048576").End(xlUp).Row)

z = WorksheetFunction.Sum((Range("F1048576").End(xlUp).Row * Range("E1048576").End(xlUp).Row * Range("D1048576").End(xlUp).Row * Range("C1048576").End(xlUp).Row * Range("B1048576").End(xlUp).Row) * Range("A1048576").End(xlUp).Row)



y = 2

 While y <= z

For i = 1 To UBound(b)

For s = 1 To UBound(a)

For j = 1 To UBound(c)

For l = 1 To UBound(d)

For m = 1 To UBound(e)



For n = 1 To UBound(c)



    Cells(y, 8).Value = a(s, 1)

    Cells(y, 9).Value = b(i, 1)

    Cells(y, 10).Value = c(j, 1)

    Cells(y, 11).Value = d(l, 1)

    Cells(y, 12).Value = e(m, 1)

    Cells(y, 13).Value = f(n, 1)





   

    y = y + 1

    Next n

    Next m

    Next l

    Next j

    Next s

    Next i

   Wend

   ActiveSheet.Range("H2:M1048576").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6)



   

Application.ScreenUpdating = True 'Desabilita atualização de tela

'Application.Visible = False 'Fecha tela

End Sub

Midori · 4 de julho de 2023

@eliarde3 Para isso tem algoritmos como o desta página que usa o método recursivo,

https://www.geeksforgeeks.org/print-all-possible-combinations-of-r-elements-in-a-given-array-of-size-n/

Deixei os elementos apenas numa coluna para facilitar,

Dim Lin As Integer

Sub GeraCombinacoes()
    Dim Elementos   As Range
    Dim R           As Integer
    Dim N           As Integer
    
    Set Elementos = [A1:A20]
        
    R = 2
    N = Elementos.Rows.Count - 1
    
    Lin = 1
    Call PrintCombination(Elementos, N, R)
End Sub

Sub PrintCombination(Elementos As Range, N As Integer, R As Integer)
    Dim Data As Variant
    ReDim Data(N)
    Call CombinationUtil(Elementos, Data, 0, N, 0, R)
End Sub

Sub CombinationUtil( _
    Elementos As Range, Data As Variant, _
    xStart As Integer, xEnd As Integer, Index As Integer, R As Integer)
    
    Dim J As Integer
    Dim I As Integer
    
    If Index = R Then
        For J = 0 To R - 1
            [C:C].Cells(Lin, J + 1) = Data(J)
        Next J
        Lin = Lin + 1
        Exit Sub
    End If

    I = xStart
    While I <= xEnd And xEnd - I + 1 >= R - Index
        Data(Index) = Elementos(I + 1)
        Call CombinationUtil(Elementos, Data, I + 1, xEnd, Index + 1, R)
        I = I + 1
    Wend
End Sub

Este é o resultado com os 20 elementos e as combinações nas colunas C:D com 190 linhas,