Questo articolo viene da una discussione sul Forum di Excel VBA. La discussione non ha avuto molto seguito in verità, però l’idea era carina (era basata su vecchio gioco) e mi ha dato uno spunto interessante per approfondire l’argomento.
Lo spunto di partenza prevede una tabella di numeri interi reali (non importa se positivi o negativi: questo aspetto rende il gioco più affascinante) e occorre raggiungere un valore obiettivo applicando a due o più elementi della tabella una o più delle quattro operazioni fondamentali (addizione, sottrazione, moltiplicazione, divisione). Nota che si può anche scegliere di escludere uno o più operatori.

La sfida non era facile ma con qualche trucco e cercando un pochino in Rete ho tirato fuori questa proposta, basata sulle combinazioni (dei numeri iniziali) e sulle permutazioni (dei simboli delle quattro operazioni).

In sostanza genero la tabella delle combinazioni dei numeri iniziali e ogni combinazione (non ripetuta) è memorizzata come stringa nella forma “m n”. Successivamente al carattere spazio viene sostituito in sequenza uno degli operatori permessi. Si ottiene una nuova sequenza di stringhe del tipo “m+n”, “m-n”, e così via.
Infine viene valutato il risultato di ogni singola stringa, e se coincide con il valore obiettivo, viene conservata la sequenza che lo origina per presentarlo, finalmente, all’utente.

Ho preparato un semplice foglio Excel che illustrerà bene tutto il meccanismo. Lo scenario prevede:
– tabella numeri iniziale (con intestazione): colonna A;
– numero obiettivo: cella D2;
– cella (D4) con hyperlink che scatena il codice sottostante.

Codice del Foglio1:

'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

Codice del Modulo1:

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

Con un userform potrebbe anche diventare un gioco carino, perchè no? magari anche una sfida a tempo con gli amici, a chi indovina più combinazioni 🙂

Scarica il file di esempio da qui!