Sub testCombinazioni()
Dim rng As Excel.Range
Dim numeri()
Dim i As Long
Dim t As Long
Dim l As Long
Dim f As Long

Set rng = [foglio1!a2:b4]

For i = 1 To rng.Rows.Count
    t = t + rng.Item(i, 2)
Next
ReDim numeri(t - 1)

For i = 1 To rng.Rows.Count
    For t = 1 To rng.Item(i, 2).Value
        numeri(l) = rng.Item(i, 1).Value
        l = l + 1
    Next
Next

SviluppaCombinazioni numeri, UBound(numeri) + 1
End Sub


Function SviluppaCombinazioni( _
            numeri(), _
            Ordine As Long) As Variant
Dim L1 As Long
Dim L2 As Long
Dim L3 As Long, L5 As Long
Dim L4() As Long
Dim arr()
Dim arrF()
Dim S As String
Dim St As String
Dim NoD As New Collection
Dim C As Long
Dim rng As Excel.Range

On Error Resume Next
L1 = UBound(numeri, 2)
    If Err Then
        Err.Clear
        On Error GoTo 0
    Else
        Exit Function
    End If


L1 = LBound(numeri)
L2 = UBound(numeri) - L1 + 1


ReDim L4(0 To Ordine)


L4(0) = 1
L4(1) = 1
For L3 = 1 To Ordine
    L4(L3) = L4(L3 - 1) * L2
Next L3

ReDim arr(1 To L4(Ordine), 0 To Ordine)
ReDim arrF(1 To L4(Ordine), 0 To Ordine)
For L2 = 0 To Ordine
    L1 = LBound(numeri)
    For L3 = 1 To L4(Ordine)
        arr(L3, L2) = numeri(L1)
        If L3 Mod L4(L2) Then
        Else
            L1 = L1 + 1
            If L1 > UBound(numeri) Then _
                L1 = LBound(numeri)
        End If
    Next
Next

L3 = UBound(numeri)

On Error Resume Next
For L1 = 1 To L4(Ordine)
    S = ""
    
    For L2 = 0 To Ordine - 1
        S = S & CStr(arr(L1, L2))
    Next
    St = S
    NoD.Add 0, St
    If Err Then
        Err.Clear
    Else
        For L2 = 0 To L3
            S = Replace(S, numeri(L2), "", , 1, vbTextCompare)
        Next
        If Len(S) = 0 Then
            L5 = L5 + 1
            For L2 = 0 To Ordine
                arrF(L5, L2) = arr(L1, L2)
            Next
        End If
    End If
Next

Set rng = [foglio2!a1]
Set rng = rng.Resize(L4(Ordine), Ordine)
rng = arrF
End Function