在Excel上显示组合

问题描述 投票:1回答:1

我有这个问题:如果某人有五个职位,并且有50个兼职员工(1-50)。 50位雇员中的每位员工可以一起经历5个职位/职位的所有可能组合是什么?

我需要在电子表格中显示所有可能性。

我在下面做了此VBA代码并计算了4176种可能性,但我认为结果应该大得多,因为组合(50,5)= 2118760。

这是对的吗?

Sub Possibilidades()

'Criar as variaveis referentes aos postos de trabalho e aos empregados
Dim jp, emp, totalemp, contjp, contemp, aux, auxemp As Integer
totalemp = Range("B1").Value
jp = Range("B2").Value
contemp = 1
'Posiciona célula para imprimir possibilidades
Range("B5").Activate

'Laço para criar blocos de 5 empregados
For emp = 1 To totalemp - 4

    'Laço para atribuir posto de trabalho a cada funcionário
    For contjp = 1 To jp
        ActiveCell.FormulaR1C1 = "=""Emp""&" & contemp
        contemp = contemp + 1
        ActiveCell.Offset(0, 1).Activate
    Next contjp
    contemp = contemp - 4
ActiveCell.Offset(1, -jp).Activate
Next emp

'Separação de blocos de comando
'ActiveCell.Offset(1, 0).Activate

'Trava em 1 funcionário e em seguida mover blocos de 4 funcionarios
For emp = 1 To totalemp - 5
    contemp = emp + 2

    'Criar bloco de 4 funcionarios pulando 1 casa para evitar repeticao, ou seja, emp3 em diante
    For aux = contemp To totalemp
        ActiveCell.FormulaR1C1 = "=""Emp""&" & emp
        ActiveCell.Offset(0, 1).Activate
            For contjp = 2 To jp
                ActiveCell.FormulaR1C1 = "=""Emp""&" & contemp
                contemp = contemp + 1
                ActiveCell.Offset(0, 1).Activate
                aux = contemp - 1
            Next contjp
        contemp = contemp - 3
        ActiveCell.Offset(1, -jp).Activate
    Next aux
Next emp

'Separação de blocos de comando
'ActiveCell.Offset(1, 0).Activate

'Trava em 2 funcionários e em seguida mover blocos de 3 funcionarios
For emp = 1 To totalemp - 6
    contemp = emp + 3
    auxemp = emp

    'Criar bloco de 3 funcionarios pulando 2 casa para evitar repeticao, ou seja, emp4 em diante
    For aux = contemp To totalemp
        ActiveCell.FormulaR1C1 = "=""Emp""&" & auxemp
        ActiveCell.Offset(0, 1).Activate
        auxemp = auxemp + 1
        ActiveCell.FormulaR1C1 = "=""Emp""&" & auxemp
        ActiveCell.Offset(0, 1).Activate
        auxemp = auxemp - 1
            For contjp = 3 To jp
                ActiveCell.FormulaR1C1 = "=""Emp""&" & contemp
                contemp = contemp + 1
                ActiveCell.Offset(0, 1).Activate
                aux = contemp - 1
            Next contjp
        contemp = contemp - 2
        ActiveCell.Offset(1, -jp).Activate
    Next aux
Next emp

'Separação de blocos de comando
'ActiveCell.Offset(1, 0).Activate

'Trava em 3 funcionários e em seguida mover blocos de 2 funcionarios
For emp = 1 To totalemp - 7
    contemp = emp + 4
    auxemp = emp

    'Criar bloco de 3 funcionarios pulando 2 casa para evitar repeticao, ou seja, emp5 em diante
    For aux = contemp To totalemp
        ActiveCell.FormulaR1C1 = "=""Emp""&" & auxemp
        ActiveCell.Offset(0, 1).Activate
        auxemp = auxemp + 1
        ActiveCell.FormulaR1C1 = "=""Emp""&" & auxemp
        ActiveCell.Offset(0, 1).Activate
        auxemp = auxemp + 1
        ActiveCell.FormulaR1C1 = "=""Emp""&" & auxemp
        ActiveCell.Offset(0, 1).Activate
        auxemp = auxemp - 2
            For contjp = 4 To jp
                ActiveCell.FormulaR1C1 = "=""Emp""&" & contemp
                contemp = contemp + 1
                ActiveCell.Offset(0, 1).Activate
                aux = contemp - 1
            Next contjp
        contemp = contemp - 1
        ActiveCell.Offset(1, -jp).Activate
    Next aux
Next emp

'Separação de blocos de comando
'ActiveCell.Offset(1, 0).Activate

'Trava em 4 funcionários e em seguida mover blocos de 1 funcionarios
For emp = 1 To totalemp - 8
    contemp = emp + 5
    auxemp = emp

    'Criar bloco de 4 funcionarios pulando 1 casa para evitar repeticao, ou seja, emp6 em diante
    For aux = contemp To totalemp
        ActiveCell.FormulaR1C1 = "=""Emp""&" & auxemp
        ActiveCell.Offset(0, 1).Activate
        auxemp = auxemp + 1
        ActiveCell.FormulaR1C1 = "=""Emp""&" & auxemp
        ActiveCell.Offset(0, 1).Activate
        auxemp = auxemp + 1
        ActiveCell.FormulaR1C1 = "=""Emp""&" & auxemp
        ActiveCell.Offset(0, 1).Activate
        auxemp = auxemp + 1
        ActiveCell.FormulaR1C1 = "=""Emp""&" & auxemp
        ActiveCell.Offset(0, 1).Activate
        auxemp = auxemp - 3
            For contjp = 5 To jp
                ActiveCell.FormulaR1C1 = "=""Emp""&" & contemp
                contemp = contemp + 1
                ActiveCell.Offset(0, 1).Activate
                aux = contemp - 1
            Next contjp
        ActiveCell.Offset(1, -jp).Activate
    Next aux
Next emp

'Conta as combinações
ActiveCell.Offset(-1, -1).Activate
auxemp = ActiveCell.Row - 4
Range("A5").Select
For aux = 1 To auxemp
    ActiveCell.FormulaR1C1 = "=Row()-4"
    ActiveCell.Offset(1, 0).Activate
Next aux

'Concatena as combinações
Range("G5").Select
For aux = 1 To auxemp
    ActiveCell.FormulaR1C1 = "=RC[-5]&"", ""&RC[-4]&"", ""&RC[-3]&"", ""&RC[-2]&"", ""&RC[-1]"
    ActiveCell.Offset(1, 0).Activate
Next aux

Range("G1").Select
ActiveCell.FormulaR1C1 = "= ""Done! Possibilities =  ""&" & auxemp

End Sub
excel vba
1个回答
0
投票

仅获得位置无关紧要的唯一组合,这将在5列中填充数字1到50的数组。

Sub mycomb()
Dim emp As Long
emp = 50


Dim arr(1 To 2118760, 1 To 5) As Variant

Dim n As Long
n = 1
Dim i As Long
For i = 1 To emp - 4
    Dim j As Long
    For j = i + 1 To emp - 3
        Dim k As Long
        For k = j + 1 To emp - 2
            Dim l As Long
            For l = k + 1 To emp - 1
                Dim m As Long
                For m = l + 1 To emp
                    arr(n, 1) = i
                    arr(n, 2) = j
                    arr(n, 3) = k
                    arr(n, 4) = l
                    arr(n, 5) = m
                    n = n + 1
                Next m
            Next l
        Next k
    Next j
Next i

Debug.Print arr(2118760, 1) & "," & arr(2118760, 2) & "," & arr(2118760, 3) & "," & arr(2118760, 4) & "," & arr(2118760, 5)


End Sub

但是您不能将其放在Excel电子表格中,因为它将超出表格范围。

© www.soinside.com 2019 - 2024. All rights reserved.