Excel: somma intelligente

[CIUFFO]

Ho allegato 'cartel1.xls' con il quale faccio il calcolo delle marche da bollo che devo apporre su delle cambiali.
Vorrei fare in modo che Excel mi calcoli quali marche da bollo devo mettere, considerando che al massimo ne posso mettere 10 e la somma deve avvicinarsi il più possibile all'importo della cambiale.
Nell'esempio per ottenere l'importo di 78,60 utilizzo 5 marche da 15,49, 1 da 0,52 e 3 da 0,21.
Le marche che ho a disposizione sono nella tabella di destra.
Se l'importo supera il massimo ottenibile con 10 marche, ne metto 10 e la differenza la pago con un versamento.
Ho provato calcolando la differenza tra l'importo e le marche partendo dalla più alta, ma così e quasi impossibile arrivare ad una differenza pari a 0.

[CIUFFO]

help

[daryl74]

Ti spiacerebbe postare il file ZIPPATO...

[CIUFFO]

Ti ringrazio

[CIUFFO]

Secondo me l'unico modo sarebbe far valutare ad excel ogni combinazione possibile di marche per poi prendere quella che dà il resto minore.
Le combinazioni sono: 300 utilizzando 2 marche, 12650 con 4 marche ecc. vedi sotto:
1 25
2 300
3 2.300
4 12.650
5 53.130
6 177.100
7 480.700
8 1.081.575
9 2.042.975
10 3.268.760

totale 7.119.515

Il problema è che non sò come fare eseguire una operazione del genere ad Excel

[daryl74]

Non ho fatto molte prove perchè sono di fretta cmq prova con questa macro.

Sub ConteggioMarche()
    
    ConteggioMarche = 0
    RigaPartenza = 10
    ColonnaRisultato = 8
    RigaRisultato = RigaPartenza
    SommaCorrente = 0
    
    ValoreDaDividere = InputBox("Immettere il valore da dividere", "Valore")
    Cells(RigaRisultato - 3, ColonnaRisultato + 1) = ValoreDaDividere
    Cells(RigaRisultato - 3, ColonnaRisultato) = "Valore"
    Cells(RigaRisultato - 1, ColonnaRisultato) = "Nro"
    Cells(RigaRisultato - 1, ColonnaRisultato + 1) = "Importo"
    For CellaValoreMarca = 7 To 31
        ValoreMarcaCorrente = Cells(CellaValoreMarca, 17).Value
        If ValoreDaDividere > ValoreMarcaCorrente Then
            NroMarche = Int(ValoreDaDividere / Cells(CellaValoreMarca, 17).Value)
                        
            ConteggioMarche = ConteggioMarche + NroMarche
            If ConteggioMarche > 9 And NroMarche = 1 Then
                GoTo fine
            ElseIf ConteggioMarche > 9 Then
                'ancora da fare...
                MsgBox ("da fare")
                GoTo fine
            End If
            Cells(RigaRisultato, ColonnaRisultato) = NroMarche
            Cells(RigaRisultato, ColonnaRisultato + 1) = ValoreMarcaCorrente
            RigaRisultato = RigaRisultato + 1
            ValoreDaDividere = ValoreDaDividere - (NroMarche * ValoreMarcaCorrente)
            SommaCorrente = SommaCorrente + NroMarche * ValoreMarcaCorrente
        End If
    Next
    
fine:
    Cells(RigaRisultato + 3, ColonnaRisultato - 1) = ConteggioMarche
    Cells(RigaRisultato + 2, ColonnaRisultato - 1) = "Nro Marche"
    Cells(RigaRisultato + 2, ColonnaRisultato + 1) = SommaCorrente
    Cells(RigaRisultato + 2, ColonnaRisultato + 2) = "Totale"
    If ValoreDaDividere > 0 Then Cells(RigaRisultato + 3, ColonnaRisultato + 1) = ValoreDaDividere
    Cells(RigaRisultato + 3, ColonnaRisultato + 2) = "Resto"
End Sub

Ciao

[CIUFFO]

Supponi di fare una cambiale di 100 euro, la tua macro mi propone:

Valore 100,00

Nro Importo
1 60,00
1 30,00
1 7,75
1 1,55
1 0,62
1 0,05


totale 99,97
resto 0,03

invece il calcolo ottimale è:

1 60,00
1 30,00
1 6,00
1 2,40
1 1,55
1 0,05


totale 100,00
resto 0,00

Secondo me l'unica è valutare tutte le permutazioni possibili ( prima pensavo alle combinazioni, ma mi sbagliavo):

1 25
2 600
3 13.800
4 303.600
5 6.375.600
6 127.512.000
7 2.422.728.000
8 43.609.104.000
9 741.354.768.000
10 11.861.676.288.000

totale 12.649.197.093.625

[CIUFFO]

Intanto grazie a Daryl74 per i suggerimenti.
Ho allegato 'Cartel 1.zip' per farti vedere in quale modo voglio fare i calcoli, sfruttando il foglio di exel riga per riga in modo da poter inserire prima i vari importi per poi effettuare il calcolo.
Ci sono però alcune cose che non riesco a risolvere:

A: con una cambiale di 11 o 16 o 19 e altri importi mi dà un resto di 0.05, perchè non aggiunge una marca da 0.05?

B: con una cambiale di 100 euro mi mette: 60+30+7.75+1.55+0.62+0.05=99.97

invece sarebbe meglio: 60+30+7.75+1.55+0.60+0.10=100

E' possibile fare una cosa del genere?

[daryl74]

In realtà in questi giorni stavo studiando un metodo...
Bisognerebbe poter massimizzare la somma di 25 valori presi a gruppi di 9 (al massimo a gruppi di 9). Forse creando in excel un foglio con tutte le combinazioni oppure con tutte le somme possibili si potrebbe risolvere (invece di calcolarle tutte le volte). Ma sinceramente non sono riuscito a creare un ciclo decente...
Se dovesse venirmi in mente qualche idea brillante... ti farò sapere.

Potresti al limite provare a fare un sottociclo sugli ultimi valori confrontando varie somme di questi con l'importo residuo da ottenere.

100 euro - 60 - 30 - 7.75 = 2.5

sul resto = 2.5 potresti fare varie combinazioni di 3 o 4 elementi dei valori più bassi presi in un massimo di 6 (3 li abbiamo già utilizzati: 60, 30, 7.75).
Confronti le somme di queste combinazioni e vedi quale si avvicina di più al valore del resto.

Questo dovrebbe limitare le combinazioni da calcolare...

DaryL74

[CIUFFO]

E' questo che non riesco a fare...

Per il problema A ho risolto così:
ValoreDaDividere = Round(ValoreDaDividere - Marca, 2)

Se ti viene un'idea...

Ciao e grazie mille

[CIUFFO]

Questo codice fa quello che voglio ma non è perfetto.
Con una cambiale di 100 euro mi mette: 60+30+7.75+1.55+0.62+0.05=99.97

invece sarebbe meglio: 60+30+7.75+1.55+0.60+0.10=100


in un modulo:

Sub ConteggioMarche()
Dim ConteggioMarche, RigaPartenza, ColonnaRisultato, ValoreDaDividere, NroMarche

ConteggioMarche = 0
RigaPartenza = 3
ColonnaRisultato = 4

For Each cambiale In Range("A3:A49")
If cambiale = "" Then Exit For
If cambiale > 600 Then
For Nro = 1 To 10
Cells(cambiale.Row, ColonnaRisultato) = 60
ColonnaRisultato = ColonnaRisultato + 1
Next
End If
For Each marca In Range("R7:R31")
If marca <> "" Then

If cambiale >= marca Then
NroMarche = Int(cambiale / marca)
ConteggioMarche = ConteggioMarche + NroMarche
If ConteggioMarche > 10 Then Exit For

For Nro = 1 To NroMarche
Cells(RigaPartenza, ColonnaRisultato) = marca
ColonnaRisultato = ColonnaRisultato + 1
cambiale = Round(cambiale - marca, 2)
Next
End If
End If
Next

RigaPartenza = RigaPartenza + 1
ColonnaRisultato = 4
ConteggioMarche = 0

Next
End Sub

[daryl74]

vedo che stai migliorando...
Io non sono riuscito a trovare di meglio di quanto ti ho già proposto.
In ogni caso ci sei quasi !!!

Ciao

[CIUFFO]

Questo codice prova tutte le combinazioni di 1,2,3,4,5,6,7,8,9,10 marche con valore da 1 a 3, ma è troppo pesante, figuriamoci con 25 valori.
Si può snellire e velocizzare?

Sub CONTEGGIO()
Dim Inizio, Inizio2, Inizio3, Inizio4, Inizio5, Inizio6, Inizio7, Inizio8, Inizio9, Inizio10
Inizio = 1
Inizio2 = 1
Inizio3 = 1
Inizio4 = 1
Inizio5 = 1
Inizio6 = 1
Inizio7 = 1
Inizio8 = 1
Inizio9 = 1
Inizio10 = 1

For Each Cell In Range("A1:A3")
Cells(1, 2) = Cell
Next

For Each Cell In Range("A1:A3")
For Each Cell2 In Range(Cells(Inizio2, 1), Cells(3, 1))
Cells(1, 2) = Cell
Cells(1, 3) = Cell2
Next
Inizio2 = Inizio2 + 1
Next

Inizio2 = 1
Inizio3 = 1

For Each Cell In Range("A1:A3")
For Each Cell2 In Range(Cells(Inizio2, 1), Cells(3, 1))
For Each Cell3 In Range(Cells(Inizio3, 1), Cells(3, 1))
Cells(1, 2) = Cell
Cells(1, 3) = Cell2
Cells(1, 4) = Cell3
Next
Next
Inizio2 = Inizio2 + 1
Inizio3 = Inizio3 + 1
Next

Inizio2 = 1
Inizio3 = 1
Inizio4 = 1

For Each Cell In Range("A1:A3")
For Each Cell2 In Range(Cells(Inizio2, 1), Cells(3, 1))
For Each Cell3 In Range(Cells(Inizio3, 1), Cells(3, 1))
For Each Cell4 In Range(Cells(Inizio3, 1), Cells(3, 1))
Cells(1, 2) = Cell
Cells(1, 3) = Cell2
Cells(1, 4) = Cell3
Cells(1, 5) = Cell4
Next
Next
Next
Inizio2 = Inizio2 + 1
Inizio3 = Inizio3 + 1
Inizio4 = Inizio4 + 1
Next

Inizio2 = 1
Inizio3 = 1
Inizio4 = 1
Inizio5 = 1

For Each Cell In Range("A1:A3")
For Each Cell2 In Range(Cells(Inizio2, 1), Cells(3, 1))
For Each Cell3 In Range(Cells(Inizio3, 1), Cells(3, 1))
For Each Cell4 In Range(Cells(Inizio3, 1), Cells(3, 1))
For Each Cell5 In Range(Cells(Inizio4, 1), Cells(3, 1))
Cells(1, 2) = Cell
Cells(1, 3) = Cell2
Cells(1, 4) = Cell3
Cells(1, 5) = Cell4
Cells(1, 6) = Cell5
Next
Next
Next
Next
Inizio2 = Inizio2 + 1
Inizio3 = Inizio3 + 1
Inizio4 = Inizio4 + 1
Inizio5 = Inizio5 + 1
Next

Inizio2 = 1
Inizio3 = 1
Inizio4 = 1
Inizio5 = 1
Inizio6 = 1

For Each Cell In Range("A1:A3")
For Each Cell2 In Range(Cells(Inizio2, 1), Cells(3, 1))
For Each Cell3 In Range(Cells(Inizio3, 1), Cells(3, 1))
For Each Cell4 In Range(Cells(Inizio3, 1), Cells(3, 1))
For Each Cell5 In Range(Cells(Inizio4, 1), Cells(3, 1))
For Each Cell6 In Range(Cells(Inizio5, 1), Cells(3, 1))
Cells(1, 2) = Cell
Cells(1, 3) = Cell2
Cells(1, 4) = Cell3
Cells(1, 5) = Cell4
Cells(1, 6) = Cell5
Cells(1, 7) = Cell6
Next
Next
Next
Next
Next
Inizio2 = Inizio2 + 1
Inizio3 = Inizio3 + 1
Inizio4 = Inizio4 + 1
Inizio5 = Inizio5 + 1
Inizio6 = Inizio6 + 1
Next

Inizio2 = 1
Inizio3 = 1
Inizio4 = 1
Inizio5 = 1
Inizio6 = 1
Inizio7 = 1

For Each Cell In Range("A1:A3")
For Each Cell2 In Range(Cells(Inizio2, 1), Cells(3, 1))
For Each Cell3 In Range(Cells(Inizio3, 1), Cells(3, 1))
For Each Cell4 In Range(Cells(Inizio3, 1), Cells(3, 1))
For Each Cell5 In Range(Cells(Inizio4, 1), Cells(3, 1))
For Each Cell6 In Range(Cells(Inizio5, 1), Cells(3, 1))
For Each Cell7 In Range(Cells(Inizio6, 1), Cells(3, 1))
Cells(1, 2) = Cell
Cells(1, 3) = Cell2
Cells(1, 4) = Cell3
Cells(1, 5) = Cell4
Cells(1, 6) = Cell5
Cells(1, 7) = Cell6
Cells(1, 8) = Cell7
Next
Next
Next
Next
Next
Next
Inizio2 = Inizio2 + 1
Inizio3 = Inizio3 + 1
Inizio4 = Inizio4 + 1
Inizio5 = Inizio5 + 1
Inizio6 = Inizio6 + 1
Inizio7 = Inizio7 + 1
Next

Inizio2 = 1
Inizio3 = 1
Inizio4 = 1
Inizio5 = 1
Inizio6 = 1
Inizio7 = 1
Inizio8 = 1

For Each Cell In Range("A1:A3")
For Each Cell2 In Range(Cells(Inizio2, 1), Cells(3, 1))
For Each Cell3 In Range(Cells(Inizio3, 1), Cells(3, 1))
For Each Cell4 In Range(Cells(Inizio3, 1), Cells(3, 1))
For Each Cell5 In Range(Cells(Inizio4, 1), Cells(3, 1))
For Each Cell6 In Range(Cells(Inizio5, 1), Cells(3, 1))
For Each Cell7 In Range(Cells(Inizio6, 1), Cells(3, 1))
For Each Cell8 In Range(Cells(Inizio7, 1), Cells(3, 1))
Cells(1, 2) = Cell
Cells(1, 3) = Cell2
Cells(1, 4) = Cell3
Cells(1, 5) = Cell4
Cells(1, 6) = Cell5
Cells(1, 7) = Cell6
Cells(1, 8) = Cell7
Cells(1, 9) = Cell8

Next
Next
Next
Next
Next
Next
Next
Inizio2 = Inizio2 + 1
Inizio3 = Inizio3 + 1
Inizio4 = Inizio4 + 1
Inizio5 = Inizio5 + 1
Inizio6 = Inizio6 + 1
Inizio7 = Inizio7 + 1
Inizio8 = Inizio8 + 1
Next

Inizio2 = 1
Inizio3 = 1
Inizio4 = 1
Inizio5 = 1
Inizio6 = 1
Inizio7 = 1
Inizio8 = 1
Inizio9 = 1

For Each Cell In Range("A1:A3")
For Each Cell2 In Range(Cells(Inizio2, 1), Cells(3, 1))
For Each Cell3 In Range(Cells(Inizio3, 1), Cells(3, 1))
For Each Cell4 In Range(Cells(Inizio3, 1), Cells(3, 1))
For Each Cell5 In Range(Cells(Inizio4, 1), Cells(3, 1))
For Each Cell6 In Range(Cells(Inizio5, 1), Cells(3, 1))
For Each Cell7 In Range(Cells(Inizio6, 1), Cells(3, 1))
For Each Cell8 In Range(Cells(Inizio7, 1), Cells(3, 1))
For Each Cell9 In Range(Cells(Inizio8, 1), Cells(3, 1))
Cells(1, 2) = Cell
Cells(1, 3) = Cell2
Cells(1, 4) = Cell3
Cells(1, 5) = Cell4
Cells(1, 6) = Cell5
Cells(1, 7) = Cell6
Cells(1, 8) = Cell7
Cells(1, 9) = Cell8
Cells(1, 10) = Cell9
Next
Next
Next
Next
Next
Next
Next
Next
Inizio2 = Inizio2 + 1
Inizio3 = Inizio3 + 1
Inizio4 = Inizio4 + 1
Inizio5 = Inizio5 + 1
Inizio6 = Inizio6 + 1
Inizio7 = Inizio7 + 1
Inizio8 = Inizio8 + 1
Inizio9 = Inizio9 + 1
Next

Inizio2 = 1
Inizio3 = 1
Inizio4 = 1
Inizio5 = 1
Inizio6 = 1
Inizio7 = 1
Inizio8 = 1
Inizio9 = 1
Inizio10 = 1

For Each Cell In Range("A1:A3")
For Each Cell2 In Range(Cells(Inizio2, 1), Cells(3, 1))
For Each Cell3 In Range(Cells(Inizio3, 1), Cells(3, 1))
For Each Cell4 In Range(Cells(Inizio3, 1), Cells(3, 1))
For Each Cell5 In Range(Cells(Inizio4, 1), Cells(3, 1))
For Each Cell6 In Range(Cells(Inizio5, 1), Cells(3, 1))
For Each Cell7 In Range(Cells(Inizio6, 1), Cells(3, 1))
For Each Cell8 In Range(Cells(Inizio7, 1), Cells(3, 1))
For Each Cell9 In Range(Cells(Inizio8, 1), Cells(3, 1))
For Each Cell10 In Range(Cells(Inizio9, 1), Cells(3, 1))
Cells(1, 2) = Cell
Cells(1, 3) = Cell2
Cells(1, 4) = Cell3
Cells(1, 5) = Cell4
Cells(1, 6) = Cell5
Cells(1, 7) = Cell6
Cells(1, 8) = Cell7
Cells(1, 9) = Cell8
Cells(1, 10) = Cell9
Cells(1, 11) = Cell10

Next
Next
Next
Next
Next
Next
Next
Next
Next
Inizio2 = Inizio2 + 1
Inizio3 = Inizio3 + 1
Inizio4 = Inizio4 + 1
Inizio5 = Inizio5 + 1
Inizio6 = Inizio6 + 1
Inizio7 = Inizio7 + 1
Inizio8 = Inizio8 + 1
Inizio9 = Inizio9 + 1
Inizio10 = Inizio10 + 1
Next
End Sub

[daryl74]

Perchè non gli fai calcolare una sola volta tutte le combinazioni di quelle 10 marche e:

---------- A
in un foglio secondario:
-nella prima colonna metti l'elenco delle marche impiegate per quella combinazione separato da ";" o "/" o altro
-nella seconda colonna metti la somma di quella combinazione

---------- B
In questo modo quando sei vicino al risultato (diciamo che ti mancano da 10 € in giù) confronti il tuo resto con la somma che si avvicina di più (presente nel foglio creato al punto A).

in questo modo non devi appesantire il calcolo tutte le volte. Non so se può funzionare ma potresti fare una prova.

Ciao

[CIUFFO]

Allo stesso risultato posso arrivarci con 10 marche, ma anche con 3, a me serve quella con meno marche possibile, perciò il ciclo esamina prima le combinazioni di 1 marca poi passa ad esaminare le combinazioni con 2 marche e così via.