Che combinazione!

Questa idea viene da una discussione sul Forum di Excel VBA.

Si tratta di un'idea carina. basata su un vecchio gioco dove viene fornita una tabella di numeri e occorre raggiungere una certa somma operando delle addizioni su due o più numeri della tabella iniziale.

Ad esempio data la tabella di numeri 2, 5, 7, 4, quali sono gli addendi che restituiscono il numero 11? La risposta è: 7 + 4, ma anche 2 + 5 + 4.

Per vedere all'opera il semplice codice proposto basta seguire poche istruzioni. Il codice si basa su una serie di combinazioni cui viene applicato l'operatore di somma ("+") e il cui risultato è valutato dalla funzione "Evaluate".

Preparazione:
- un foglio di Excel vuoto
- una serie di numeri (ne bastano otto o dieci) a caso tra 1 e 10 dalla cella A2 in giù;
- un numero obiettivo nella cella D2, non superiore, ovviamente, alla somma algebrica dei numeri iniziali;
- il codice seguente, da avviare con Alt-F8: il risultato è depositato nella finestra Immediata (quindi occorre aprire l'editor di codice con ALt-F11 e attivare la finestra Immediata con Ctrl-G).

Enjoy!

Option Explicit

'goal_by_addenda
'centra l'obiettivo come somma di addendi
'VF 3-11-2018

Sub goal_by_addenda()
Dim v() As Variant
Dim i As Long, j As Long
Dim s As String
Dim ac As Range

    'numero di elementi nella tabella iniziale
    'la tabella ha un header: i numeri iniziano in A2
    i = [COUNTA(A:A)] - 1
    
    'preparazione dell'array
    ReDim v(i) As Variant
    For j = 0 To i
        v(j) = Cells(j + 2, "A")
    Next
    
    'calcola le combinazioni
    For j = 2 To i
        combinations v, j
    Next
    Debug.Print "Fine procedura."
End Sub


Private Sub combinations(ByRef arr(), ByVal r As Long)
Dim n As Long, i As Long, j As Long
Dim idx() As Long
Dim s As String
Dim ev As Long
    
    'prepara le combinazioni di numeri
    'presi a r elementi alla volta
    'tiene conto del numero di elementi nell'array
    n = UBound(arr) - LBound(arr)
    If r > n Then
        Debug.Print "Errore numero raggruppamenti troppo alto"
        Exit Sub
    End If

    'riempie il vettore di confronto
    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
            ' prepara la somma degli addendi
            s = s & arr(idx(j)) & " + "
        Next j
        s = Left(s, Len(s) - 3)
        ' calcola il risultato
        ev = Evaluate(s)
        ' lo confronta col risultato atteso
        ' e se combacia propone la sequenza
        If ev = Range("D2") Then
            Debug.Print s & " = " & ev
        End If

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

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

Uno sviluppo futuro, su cui peraltro ho già lavorato, prevede la possibilità di ampliare gli operatori a disposizione, oltre la semplice somma, e di poter così calcolare in quanti modi, con le quattro operazioni, si può raggiungere l'obiettivo richiesto.

posted @ sabato 3 novembre 2018 20:36

Print

Comments on this entry:

No comments posted yet.

Your comment:



 (will not be displayed)


 
 
 
Please add 8 and 8 and type the answer here:
 

Live Comment Preview: