Il blog di Francesco Cadin

'codice in Foglio1
Option Explicit

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Dim v As Variant, arr() As Variant
Dim i As Long, j As Long

    If Target.Range(1) = Range("D4") Then
        i = [COUNTA(A:A)] - 1
        ReDim arr(i) As Variant
        For j = 0 To i - 1
            arr(j) = Cells(j + 2, "A").Value2
        Next
         
        i = 2
        Range("G:G").ClearContents
        Range("G1") = "Risultati:"
        For Each v In Split(find_goal(arr, Range("D2")), vbNewLine)
            Cells(i, "G") = v
            Cells(i, "G").NumberFormat = "Text"
            i = i + 1
        Next
        
        MsgBox "Procedura completata.", , [COUNTA(G:G)] - 1 & " operazioni"
    End If
End Sub

Option Explicit 

' fondamentale lasciare gli spazi nella stringa, anche quello finale!
Private Const ALLOWED_OPERATORS = "+ - * / "

Private sTmp As String

Public Function find_goal(nums(), goal As Long) As String
Dim i As Long, j As Long
Dim s As String
Dim ac As Range
Dim k As Variant
Dim nops As Long
Dim m As String
Dim z As String
Dim t As String
Dim q As String
Dim n As Long
    
    ' calcola le combinazioni dei numeri della tabella iniziale
    ' raggruppandoli a coppie, terne, quaterne e così via
    For j = 2 To UBound(nums)
        s = s & get_combinations(nums, j)
    Next
    s = Left(s, Len(s) - 2)
    
    ' per ogni combinazione applica in sequenza (permutandoli)
    ' gli operatori della const ALLOWED_OPERATORS
    ' per esempio la combinazione "5 2"  viene trasformata
    ' in sequenza in "5+2", "5-2", "5*2", "5/2"
    ' infine valuta l'espressione risultante
    ' se il risultato è uguale all'obiettivo lo conserva
    ' e lo restituisce al codice chiamante (in Foglio1)
    For Each k In Split(s, vbNewLine)
        nops = UBound(Split(k))
        z = PermutationsN_P_R(nops)
        For j = 1 To Len(z) Step nops
            m = Mid(z, j, nops)
            t = k
            For n = 1 To nops
                t = Replace(t, " ", Mid(m, n, 1), , 1)
            Next
            
            If Evaluate(t) = goal Then
                q = q & t & vbNewLine
            End If
        Next
    Next
    
    find_goal = q
End Function


Public Function get_combinations(ByRef arr(), ByVal r As Long) As String
Dim n As Long, i As Long, j As Long
Dim idx() As Long
Dim s As String
    
   'genera le combinazioni dei numeri nella tabella iniziale
   'i numeri vengono combinati a gruppi di r elementi e
   'sono separati da uno spazio che poi verrà riempito dagli operatori
   'definiti nella const ALLOWED_OPERATORS

    n = UBound(arr) - LBound(arr)

    ReDim idx(r - 1) As Long
    For i = 0 To r - 1
        idx(i) = i
    Next i

    Do
        s = ""
        For j = 0 To r - 1
            s = s & arr(idx(j)) & " "
        Next j
        get_combinations = get_combinations & Trim(s) & vbNewLine

        ' localizza il penultimo indice
        i = r - 1
        While (idx(i) = n - r + i)
            i = i - 1
            ' termine delle iterazioni
            If i < 0 Then
                Exit Function
            End If
        Wend

        ' predispone il successivo ciclo
        idx(i) = idx(i) + 1
        For j = i + 1 To r - 1
            idx(j) = idx(i) + j - i
        Next j
    Loop
End Function


' PGC Dez 2009
' Permutations of N elements taken 1 to p at a time
Function PermutationsN_P_R(n As Long) As String
Dim vElements As Variant
Dim vResult() As Variant
Dim s As String, i As Long

    ' genera le permutazioni degli operatori definiti nella costante iniziale
    ' in modo che vengano assegnati in sequenza agli spazi vuoti della stringa
    ' contenente la combinazione corrente
    ' la permutazione è ripetuta per cui si avrà +++, ---, ** e ////

    vElements = Split(ALLOWED_OPERATORS)

    sTmp = ""
    ReDim vResult(n)
    s = get_permutationsNPR(vElements, n - 1, vResult, 0, vbNullString)
    PermutationsN_P_R = s
End Function
 
Private Function get_permutationsNPR(vElements As Variant, p As Long, vResult As Variant, iIndex As Integer, s As String) As String
Dim i As Long

    ' funzione ricorsiva di supporto a PermutationsN_P_R
    ' crea le permutazioni di n elementi dell'array di operatori
    ' a gruppi di r
    
    sTmp = s
    For i = 0 To UBound(vElements)
        vResult(iIndex) = vElements(i)
        If iIndex = p Then
            sTmp = sTmp & Join(vResult, vbNullString)
        Else
            Call get_permutationsNPR(vElements, p, vResult, iIndex + 1, sTmp)
        End If
    Next i
    get_permutationsNPR = sTmp
End Function