excel: formula per capire un totale da varie cifre

[gamma_ray]

Al lavoro è arrivato un pagamento relativo a varie prestazioni, per un importo totale di 5610,12 Euro. Io ho diversi totali delle singole prestazioni, che sono state fatte in date diverse, ed il pagamento è relativo solo ad alcune prestazioni. Siccome non mi è arrivato il riepilogo dettagliato del pagamento, volevo sapere se era possibile creare una formula che potesse individuare le combinazioni (tra i vari importi delle prestazioni) che potrebbero dare quel determinato totale generale (5610,12).
Grazie a tutti per l'aiuto.

[Ribonix]

Una formula no. Ma una macro che ne calcoli il totale combinando le singole righe sì.
E più righe sono e più le combinazioni sono esponenziali: salvo errori ed omissioni su circa una 20na di importi le possibilità sono circa 2^20 (524.288!!!)

[Ribonix]

Spero di esserti d'aiuto dandoti questo codice che ho buttato giù velocemente. L'algoritmo si basa sulla notazione esponenziale binaria ( 1 importo da inserire nel computo, 0 non inserire)
Presumiamo di aver messo in un foglio vuoto in A1 la prima cifra, in A2 la seconda, in A3 la terza e così via...

Codice: Seleziona tutto

1.274,87
3.865,10
7.218,38 *
2.730,38
2.996,70
2.822,61
6.558,47
1.601,10
1.181,09
1.321,56 *
4.325,34
3.336,95
8.619,41
4.550,10 *
7.341,66
5.334,00
   87,90
3.173,60
8.515,53


noi vogliamo ad esempio risolvere quali importi formano 13090,04 (sono i 3 contrassegnati con l'asterisco)

puoi inserire questa macro:

Codice: Seleziona tutto

Sub binario()
totale# = 0

Rem qui verrà inserito l'importo da quadrare
totalone# = 13090.04

Rem qui verranno segnalate le righe degli importi che andranno a formare il totalone#
righe = ""

Rem valori che hai inserito da A1 in poi...
valori = 19
Do
    x = x + 1
    if x>2^(calori+1) then exit do
    For t = 0 To valori
        If x And (2 ^ t) Then
            totale# = totale# + Range("a" & t + 1).Value
            righe = righe & "A" & t + 1 & " "
        End If
    Next
    If totale# = totalone# Then
        MsgBox righe & vbCrLf & (totale#)
        Exit Do
    End If
    totale# = 0
    righe = ""
Loop
End Sub


Alla fine dell'esecuzione della macro verranno visualizzate dentro una messagebox le celle che compongono l'importo totale da verificare.
Più saranno gli importi più lungo sarà il tempo di esecuzione della macro.

[gamma_ray]

Credevo che fosse più semplice... , comunque grazie.

[gamma_ray]

Non avevo visto l'altra risposta...ok, ma come faccio ad impostare questa macro?

[Ribonix]

Piccolo errore:

ho scritto

if x>2^(calori+1) then exit do

devi scrivere:

If x > 2 ^ (valori) Then Exit Do


dunque, creato il foglio vuoto devi fare così: dal menu Strumenti di Excel - Macro - Visual basic editor
nella finestra vuota incolli da Sub binario() a End Sub

poi sempre da strumenti, fai macro - macro - binario

[ezechiel2517]

volevo sapere se era possibile creare una formula che potesse individuare le combinazioni (tra i vari importi delle prestazioni) che potrebbero dare quel determinato totale generale (5610,12).

Ribonix cosi si ferma alla prima che incontra!!!

Gamma, se ti interessano tutte puoi fare cosi:
in a1,a10 hai i tuoi valori
lasci libero b1,b10
in c1 metti la formula =a1*b1 e copi verso il basso
in d1 metti la formula =somma(c1:c10)-valorechevuoiraggiongere


poi usi copi il codice qui sotto e lo incolli

Codice: Seleziona tutto

Sub BruteSolver()
    Dim x As Double, MyRange As Range, bmax As Integer

    Application.ScreenUpdating = False
   
    Set valrange = Range("a1:a10")
    Set MyRange = Range("b1:b10")
    Set OutputCell = Range("f1")
    Set WatchVal = Range("d1")

    bmax = MyRange.Rows.Count

    For n = 2 ^ bmax To 1 Step -1
        x = n
'sai quanti addendi ti servono??
'se si togli l'apice a questo IF e metti il numero di addendi
        'If Application.WorksheetFunction.Sum(MyRange)=8 then
             If WatchVal.Value = 0 Then
                Application.ScreenUpdating = True
                MyRange.Copy OutputCell.Offset(0, c)
                c = c + 1
                Application.ScreenUpdating = False
            End If
            Application.StatusBar = n
'e togli l'apice anche a questo endif
        'End If
    Next n

    Application.ScreenUpdating = True
    Application.StatusBar = False

End Sub

Function BinConArray(Dec As Double, BitMax As Integer, Optional Str As Boolean) As Variant

    Dim Bit As Integer, BinArray As Variant
    ReDim BinArray(BitMax - 1, BitMax - 1)
   
    For i = BitMax To 1 Step -1
        If Dec >= 2 ^ (i - 1) Then
            Bit = 1
            Dec = Dec - 2 ^ (i - 1)
        Else
            Bit = 0
        End If
        BinArray(0, j) = Bit
        j = j + 1
    Next i

    For i = BitMax To 1 Step -1
        BinArray(i - 1, 0) = BinArray(0, i - 1)
    Next i

    BinConArray = BinArray

End Function

ah...ok puoi anche togliere il EXIT DO

Codice: Seleziona tutto

If totale# = totalone# Then
        MsgBox righe & vbCrLf & (totale#)
        Exit Do '<==questo
    End If

nel codice di ribonix, ma devi segnarti in un foglio le combinazioni che ti da

[Ribonix]

non so se capita anche ha voi... Ho fatto delle ulteriori prove...
mi sono accorto che alcune volte la somma di addendi non è uguale al totale solo perchè questa varia dall'altro per un errore nella 7ma-8va cifra di decimale e oltre... questo errore su vari pc...
per cui ho dovuto modificare leggermente il codice... eliminando anche l'exit do che mi diceva ezechiel a discapito del maggior tempo di esecuzione della macro stessa... per via del controllo di tutte le combinazioni possibili per arrivare al totale sperato.
per cui il mi codice definitivo è questo (quello di ezechiel è nettamente migliore e con una buona conoscenza"professionale" di excel ma mi pare un po' complessa l'esecuzione e la macro...) premesso che ora bisogna solo mettere in B1 il totale da quadrare e in B2 la quantità dei dati da combinare nella somma...

Codice: Seleziona tutto

Sub binario()
totale# = 0

Rem importo da quadrare
totalone# = Range("B1").Value

Rem qui verranno segnalate le righe degli importi che andranno a formare il totalone#
righe = ""

Rem valori che hai inserito da A1 in poi...
valori = Range("B2").Value

Do
    x = x + 1
    If x > 2 ^ (valori) Then Exit Do
    For t = 0 To valori
        If x And (2 ^ t) Then
            totale# = totale# + Range("a" & t + 1).Value
            'Range("b" & t + 1).Value = Range("a" & t + 1).Value
            righe = righe & "A" & t + 1 & " "
            'Else
            'Range("b" & t + 1).Value = 0
        End If
    Next
    If Round(totale#, 2) = Round(totalone#, 2) Then
        MsgBox righe & vbCrLf & (totale#)
        'Exit Do
    End If
    totale# = 0
    righe = ""
Loop
MsgBox ("elaborazione terminata")
End Sub


E' vero che bisogna trascrivere i valori della msgbox e la cosa era quasi intenzionale, ma, se non erro, il ricalcolo delle formule anche senza screenupdating, non fa aumentare il tempo di esecuzione della macro?...

Comunque gamma_ray le soluzioni le hai, spero che tu sia riuscito a risolvere il problema...

[gamma_ray]

Grazie, stasera provo e faccio sapere.

[BianConiglio]

oh ma telefonare a chi ti ha inviato i soldi no ?

[gamma_ray]

oh ma telefonare a chi ti ha inviato i soldi no ?

Sarebbe troppo facile!

[gamma_ray]

Ciao Ribonix, ho provato a seguire la tua procedura, ma non mi succede niente.
Non ho mai usato excel in questo modo, quindi di sicuro sbaglio qualche passaggio.
Ho fatto un elenco di importi fittizzi da a1-a10.
Poi strumenti/macro/visual basic editor, ed ho incollato i dati postati.
Ma poi? Devo salvare? Il percorso "macro - macro - binario" non ce l'ho.
Mi potresti guidare un pò più passo a passo dopo l'incolla.
(stesso impedimento anche con il suggerimento di ezechiel2517).
Grazie

[ezechiel2517]

Dopo che hai incollato puoi anche non salvare, non e' necesario se stai facendo un test (ma cmq non guasta! )
Ora torna sul foglio di excel e premi alt+f8. ti si apre un form con tutte le macro che hai scritto o registrato. Clicca due volte su binario (se vuoi lanciare la macro di ribonix) o su BruteSolver (se vuoi lanciare la mia) e armati di santa pazienza!

[ezechiel2517]

ahh dimenticavo, nel codice di ribonix potrebbe darti un errore. Se dovesse accadere che ti dice "variabile non definita" vai in alto nella pagina del codice (alt+f11 se hai chiuso la finestra) e metti l'apice prima di Option Explicit.

[Ribonix]

Dove avrei messo Option Explicit?

[ezechiel2517]

Tu... da nessuna parte!!!
ma vba lo mette in automatico se metti il flag in strumenti-->opzioni
in genere si consiglia di lasciarlo perche' obbliga alla dichiarazione delle variabili e rende il codice piu' leggibile (anche se leggermente piu' lungo).

[Ribonix]

ah... ecco!!!
Ma il flag lo devi settare intenzionalmente perchè di default sulla "dichiarazione di variabili obbligatoria" non c'è (l'ho appena verificato su una 15na di pc dove ho installato nei giorni scorsi Office)...
Per il resto sono d'accordo con te... la mia è una "deformazione" dei tempi del mitico C64 quando per costruire un programma non serviva dichiarare le variabili... terrò comunque presente il tuo prezioso consiglio non saranno quel centinaio di byte in più a rallentare l'esecuzione di un programma

[gamma_ray]

Grazie per il file che mi hai inviato Ribonix. Inoltre con le istruzioni sull'eseuzione della macro sono riuscito a crearne una in un documento nuovo.
Ho solo un problema: una volta eseguita la macro, excel si blocca: il documento devo chiuderlo dal task manager.
Cosa può essere?
Grazie

[Ribonix]

Non è che si blocca, la macro non fa il refresh dello schermo, devi aspettare che finisca il computo e alla fine dello stesso apparirà una messagebox con scritto elaborazione terminata. Ok?

[gamma_ray]

No, si bloccava proprio. Nel task manager risultava bloccato.
Comunque ho risolto perchè proprio ieri sera, per vari motivi, ho fatto l'aggiornamento di office 2000 al SR 1 (vecchissimo, ma ancora non l'avevo fatto!), e tra i vari problemi corretti c'è anche questo.
Ora funziona tutto alla perfezione.
Grazie ancora perchè il file mi è utilissimo.
Alla prossima.
Ciao