Как составить список / сгенерировать все возможные комбинации в Excel

Question

В настоящее время примерно пять тысяч номеров в пяти столбцах. Числа варьируются от 1 до 47. Нужно получить счетчик каждой двухзначной комбинации:

NUMB_1  NUMB_2  NUMB_3  NUMB_4  NUMB_5  NUMB_6
2   4   5   14  21  38
10  23  26  30  40  46
1   10  25  37  43  47
16  18  23  24  38  40
1   15  18  21  28  39
9   11  13  19  38  39
2   6   9   25  27  45
2   20  24  28  35  47
3   4   25  30  36  45
11  18  20  25  27  30
2   6   7   36  45  47

Попытка получить счетчик каждой возможной двухзначной комбинации

1&2, 1&3, 1&4 thru 1-47 
2&3, 2&4, 2&5 thru 2-47
3&4, 3&5, 3&6 thru 3-47 

и все числа до

40&47, 41&47, 42&47, 43&47, 44&47, 45&47, 46&47

Answer 1

Вы можете создать очень быстрый массовый счет со словарем. Зацикливание массива вместо повторных чтений с рабочего листа ускоряет процесс.

Option Explicit

Sub num_and_num_count()

    Dim i As Long, j As Long, m As Long, n As Long, cmbo As String
    Dim arr As Variant, nums As Object

    Set nums = CreateObject("scripting.dictionary")

    With Worksheets("sheet5")

        arr = .Range(.Cells(2, "A"), .Cells(.Rows.Count, "F").End(xlUp)).Value2

        For i = LBound(arr, 1) To UBound(arr, 1)
            For j = LBound(arr, 2) To UBound(arr, 2)
                For m = LBound(arr, 1) To UBound(arr, 1)
                    For n = LBound(arr, 2) To UBound(arr, 2)
                        If arr(i, j) < arr(m, n) Then
                            cmbo = Format(arr(i, j), "00") & Format(arr(m, n), "00") & _
                                   Join(Array(arr(i, j), arr(m, n)), Chr(38))
                            nums.Item(cmbo) = nums.Item(cmbo) + 1
                        End If
                    Next n
                Next m
            Next j
        Next i

        .Cells(1, "H").Resize(1, 2) = Array("combinations", "count")
        .Cells(2, "H").Resize(nums.Count, 1) = Application.Transpose(nums.keys)
        .Cells(2, "I").Resize(nums.Count, 1) = Application.Transpose(nums.items)

        With .Range(.Cells(2, "H"), .Cells(.Rows.Count, "I").End(xlUp))
            .Sort key1:=.Cells(1), order1:=xlAscending, Header:=xlNo
            .Columns(1).TextToColumns Destination:=.Cells(1), DataType:=xlFixedWidth, _
                                      FieldInfo:=Array(Array(0, 9), Array(4, 1))
        End With

    End With
End Sub