Newsgroup: it.comp.lang.visual-basic
Titolo: VB6  Questo Loop non mi riesce

Pensavo fosse più semplice, ma poi invece non riesco a cominciare.
 
Ho un certo numero di fatture (diciamo max 50) di vari
importi.
Il mio cliente ogni mese me ne paga un certo numero
con un unico bonifico.
L'impoorto del bonifico è la somma esatta degli importi
di alcune fatture.
Devo riuscire a capire, senza chiederglielo, quali fatture
mi ha pagato.
 
Come fare?
 
Grazie e saluti.
 
Sauro 
 
 

 ha
scritto:

Metti in un array gli importi di tutte le fatture
 
Cominci a sommare  tutti gli importi partendo ogni volta dal numero negato
corrispondente all'indice che stai usando.
 
Dopo ogni somma compari i numeri.
 
Es,
 Fat(0) = 0
 Fat(1) = 1200,00
 Fat(2) = 1500,00
 Fat(3) = 1800,00
 
Sommi tutte le fatture partendo da 0 e ricordi l'indice.
 
La prima volta parti da zero e le sommi tutte, la seconda volta parti da
-1200,00 e le sommi tutte di nuovo, ti verrà il totale meno l'indice(1) e così
via fino alla fine.
 
Dal momento che i confronti e le somme sono molte, ti converrebbe evitare i
Double, meglio  i Single o i Currency.
 
 
--
ciao
  Stefano

Double, meglio  i Single o i Currency.
 
Mi correggo, meglio ancora usare i Long moltiplicati per 100
es. 1200,00  = 120000 e fare somme e confronti tra Long, dovrebbe andare molto +
veloce.
 
--
ciao
  Stefano

Sauro ha spiegato il 22/04/2012 :
zac
 
NON PUOI!!!!
...Se non ti da gli estremi (nr fattura) è impossibile!
 
Esempio
 
Fatt 1 di 500 euro
Fatt 3 di 450 euro
fatt 6 di 250 euro
fatt 9 di 300 euro
 
 
ti fa un bonifico di 750 euro...quale ti ha saldato?
la 1 e la 6
oppure
la 3 e la 9
????????????
 
e l'ho fatta facile!!!....nella realtà ci sono poi arrotondamenti e 
pagamenti parziali!
 
-- 
----- Italliaaaaa 3227! -----
Please, visits website, but please visit Italy. We’re t’best country in 
the world in terms of: Culture, Landscapes, Arts, History, Cities, 
Villages, Beautiful countryside, seaside, mountains. That is Italy. You 
know, perhaps, you dreaming about. But please, visit or country. We 
will welcome you warmly and with a better organization.
(Francesco Rutelli Video a: 
http://www.martek.it/dblog/mostraVideo.asp?p=/public/dblog/Rutelli1.wmv
 
)
 
 


Stefano forse non hai capito la problematica...
Mettiamo che ho 50 fatture tutte da 100 euro e il cliente mi fa un 
bonifico di 1000 euro, quale seleziono?!?! Non è un problema di array, 
long, currency, ecc... non si può proprio fare senza qualche 
informazione aggiuntiva.
 
Ciao, Vincenzo

 parziali!
 
solo 1 strada. ordina per data e numero e consideri incassate le più 
"anziane"
 
 

Diamo per scontato che nessun importo è
uguale a un altro.
 
Per la verità non ho capito il metodo di
Stefano.
 
Sauro 
 
 

 "anziane"
 
SELECT * From Fatture ORDER BY Data DESC , Importo ASC (O desc decidi 
tu)...in cima le più vecchie....
CONTINUA A NON AVER SENSO
 
esempio
Data     nr fatt    importo
1/1/12  AB 1223     200
1/1/12  AB 1119     100
1/4/12  AB 1724     200
1/4/12  AB 4231     100
12/4/12 AB 5521     300
 
ti pago la AB1223 la AB1724 la AB5521  200+200+300= 700
tu quali considereresti pagate?
 
SE NON LO SAI
potresti considerare la AB1223+ AB1119 + AB4231+ AB5521= 
200+100+100+300=700
 
Tutto fuorchè reale....tutto fuorchè logico!
E se ti prende il tuo commercialista o impiegato contabile ti fa fare 
una corsa che sorpassi Bolt!!! Lo capisci che così in contabilità non 
torna un cazzo???!!! scusa la finezza!
Spero sia un programma fatto così, per imparare, e non applicato ad una 
situazione reale!!!
 
SE LO E' sei in questa esatta situazione
http://www.facebook.com/photo.php?fbid=1918499136232&set=a.1918427694446.106995.1654637325&type=3&theater
 
 
eh eh eh!
 
-- 
----- Italliaaaaa 3227! -----
Italian way to work flexibility
http://www.facebook.com/photo.php?fbid=3008023093650&set=a.3007867849769.136344.1654637325&type=1&theater
 
 
 

 pagamenti parziali!
 
Gli importi sono per esempio.
4375,24
346,12
6893,73
 
Le probabilità che fatture diverese da quelle effettivamente
pagate diano lo stesso esatto totale sono minime.
 
Sauro
 
 
 

 "anziane"
 
Fin qui ci sarei arrivato anche da solo.
 
Se ho posto il problema è proprio perchè le fatture vengono pagate
con un criterio (deciso dal cliente e che non conosco) diverso da
quello della data di emissione o di scadenza.
 
Sauro. 
 
 

 via fino alla fine.
 
Grazie Stefano per le tua risposta; però non ho capito.
A parte il discorso dei long che posso applicare.
 
Supponiamo:
Fat(0)=3456,78
Fat(1)=4567,23
Fat(2)=9876,56
Fat(3)=666,77
Fat(4)=432,87
Fat(5)=8888,51
Fat(6)=333,99
Fat(7)=876,54
Fat(8)=4680,74
 
Supponiamo inoltre che il totale sia dato da:
Fat(2)+Fat(5)+Fat((7)
 
Non ho capito come il tuo loop li possa trovare.
 
Sauro 
 
 

Sauro ha scritto:

Provi tutte le possibili combinazioni e calcoli il totale
di ognuna.
Selezioni solo le combinazioni col totale corretto, che in
teoria dovrebbe essere una sola... ma se c'è più di una
combinazione che dà lo stesso totale prediligi quella con
le fatture con date più vecchie.
 
Ma anche così, non c'è garanzia di esattezza... niente ti
garantisce che non si siano più fatture con lo stesso valore,
e niente poi ti garantisce che il cliente per qualche motivo non
consideri pagata una fattura più recente lasciando indietro
una più vecchia. Ipotizza per esempio una contestazione...
 
Sorry, ma la strada buona è una sola: se al cliente viene
concessa la possibilità di scegliere le fatture da pagare,
gli va anche data la responsabilità di dichiarare quali sta
pagando. Gli automatismi in casi come questi sono fallibili
per definizione.
 
Bye, G.

 per definizione.
 
Dimenticavo: paga con bonifico, hai detto... in un bonifico
c'è un campo (obbligatorio ?) per la causale, ed è lì che il
cliente *deve* dire cosa pensa di star pagando.
 
Bye, G.

 per definizione.
 
Rispondo anche al tuo secondo post in merito al bonifico
chiedendovi, per favore, di tralasciare le contestazioni
alla mia domanda e di darmi qualche aiuto per trovare
la soluzione.
 
Devo confessare che, oltre al problema reale risolvibile
con un migliore rapporto con un cliente comunque molto
ostico, mi sono fatto intrigare dal problema in sè che
vorrei riuscire a risolvere col vostro aiuto.
 
Sauro 
 
 

 Sauro
Le probabilità sono una cosa...la contabilità un altra!
Quindi CONTABILMENTE
indica nella causale quale fattura paga! Non ci son cazzi....poi che il 
rapporto cliente fornitore non sia rose e fiori non aspettavemao certo 
te che venissi a dircelo!....qualsiasi ragionere lo sà!
 
DIDATTICAMENTE
hai parlato di probabilità?...usa la teoria del lotto(ossia il calcolo 
combinatorio)...ed un algoritmo brute force....
E' la solita cosa di "Genera ambi e terni da X numeri"
 
metti gli importi in una matrice
e prova tutte le combinazioni di n estrazioni degli indici della 
matrice
 
es
INDICE MATRICE
importi(A)
importi(B)
importi(C)
importi(D)
importi(E)
 
Profondita 2...combinazioni...
AB AC AD AE
BC BD BE
CD CE
DE
Somma i corrispettivi valori e vedi se uno rispetta l'importo!
 
Altrimenti....
RESET
 
Profondita 3
ABC ABD ABE
BCD BCE
CDE
e cosi' via
 
un loop fatto bene...una variabile indicematrice....un pc
FATTO
 
PERO' NON PUOI NON PRESCINDERE
dal fatto che ti si dica che così è sbagliato contabilmente! A maggior 
ragione perchè non vuoi far una telefonata al cliente che ti mette in 
soggezione!...io fossi il cliente se so che fai così ci marcerei alla 
grande!!!!Nessuno è contento di pagare!
Cioè...esiste la teoria ed esistono le regole...in contabilità devi 
registarre cosa ti paga...altrimenti non tenere nemmeno la 
contabilità....tanto non ti tornerà mai un cazzo!
 
-- 
----- Italliaaaaa 3227! -----
Soldato Joker, cosa ci fa il soldato Palla di Lardo con quel fucile in 
mano nel mio fottutissimo bagno?
 
Sergente Artman [ da: "Full Metal Jacket" ]
 
 

 E' la solita cosa di "Genera ambi e terni da X numeri"
 
Senza stare a menarsela con do loop e vari incasinamenti
 
 
Pseudo codice...
option base 1
dim IMPORTI(50)
dim GOAL as currency
 
prova 3 combinazioni
 
 
FOR X=1 to 50 prima cifra
 for Y= 2 to 50 seconda cifra
   FOR z= 3 to 50 terza cifra
    TEST=IMPORTI(X)+IMPORTI(Y)+IMPORTI(Z)
    IF GOAL = TEST
       BINGO TROVATO
    ENDIF
   NEXT z
  NEXT y
NEXT x
 
....e così via....
aumentando la profondità ad ogni "set di numeri" che vuoi provare
le quartine hanno bisogno di un ulteriore
FOR W=4 to 50....
 
TUTTO è parametrizzabile (e te lo lascio come esercizio) non scrivendo 
10 funzioni per 10 profondità....ma si entra nel campo delle funzioni 
ricorsive....


 NEXT x
 
Una precisazione: non trattandosi di lotto e nenanche
totocalcio :-P qui bisogna anche controllare che X, Y e Z
siano diversi  l'uno dall'altro, altrimenti si rischia di
sommare più volte la stessa fattura. Così a occhio:
 
FOR X=1 to 50 'prima cifra
  for Y= 2 to 50 'seconda cifra
   if Y <> X then
    FOR z= 3 to 50 'terza cifra
     if (Z <> Y) and (Z <> X) then
      TEST=IMPORTI(X)+IMPORTI(Y)+IMPORTI(Z)
      IF GOAL = TEST
       ' BINGO TROVATO
      END IF
     end if
    NEXT z
   end if
  NEXT y
NEXT x
 
Anche se penso che ci sia qualche metodo più furbo.
A proposito: visto che il numero di fatture pagate non è
per forza tre, toccherà preparare la routine per un massimo
di N possibili fatture pagate in contemporanea, e poi
fermarsi nei for-next al punto corrispondente al numero
di fatture effettivamente pagate.
In alternativa, controllare ad ogni singolo for e uscire
del tutto quando c'è la corrispondenza, roba tipo così:
 
FOR X=1 to 50 'prima cifra
  TEST=IMPORTI(X)
  if test= goal then exit for
   for Y= 2 to 50 'seconda cifra
    if Y <> X then
     test=test+IMPORTI(Y)
     if test= goal then exit for
    FOR z= 3 to 50 'terza cifra
     if (Z <> Y) and (Z <> X) then
      TEST=test+IMPORTI(Z)
      if test= goal then exit for
     end if
    NEXT z
   end if
  NEXT y
NEXT x
 
Ovviamente si deve tenere in un'altra matrice l'elenco
delle fatture effettivamente sommate.
 
(Scritto al volo: non posso ricontrollare, mi stanno
chiamando...)
 
Bye, G.

 Wodka40° ha scritto:
mmmmmm
a paperì che az dici? Chissenefrega se ne ha 2 uguali?!!!Avrà lavorat 
le solite ore!
 
lui ha 50 fatture ha detto:
QUINDI
 
 
goal= 12345,78
Fattura(1) più vecchia importo
....
Fattura(n) più nuova importo
 
for x=1 to ubound(fattura)
   for y=2 to ubound(fattura)
 
     test=fattura(x)+fattura(y)
    if goal = test then
       msgbox trovato i valori sono fattura(x) e fattura(y) di indice x 
e y
   exit da tutto
...e così via!!!!
 
 
 
 
siccome il calcolo anche da se si vede che è ricorsivo
può ovviare alla eventuale profondità ignota usando funzioni 
ricorsive....ma francamente non mi pare che  sia in grado l'autore del 
post....e non voglio quindi incasinarlo!
 
 
Dai di la verità....sei in crisi glicemica!...Io lo sono! ...sono a 
dieta!
 
-- 
----- Italliaaaaa 3227! -----
Mi disturba la morte, è vero. Credo che sia un errore del padreterno. 
Non mi ritengo per niente indispensabile,
ma immaginare il mondo senza di me: che farete da soli?
(Vittorio Alfieri)
 
 

 ...e così via!!!!
 
Rifletti un attimo: in questo modo gli succede di sommare
due (o più) volte per esempio la fattura n. 3. Se per caso,
improbabile che sia, gli desse il risultato giusto ?
 
Somma pagata = 2340,66
 
Fatture da pagare:
1: 960.20
2: 677.88
3: 120.20
4: 1112.48
5: 456.07
6: 984.90
7: 325.11
8: 550.30
9: ....
10: ....
 
Il cliente intendeva pagare le fatture numero 2, 4 e 8:
   677.88 + 1112.48 + 550.30 = 2340,66
*MA* un algoritmo che non controllasse le ripetizioni
considererebbe pagate le 2, 2 e 6:
   677.88 + 677.88 + 984.90 = 2340,66
Il che sarebbe ovviamente sbagliato.
 
Un'alternativa al controllo diretto (If X <> Y)potrebbe
essere modificare il tuo:
 
for x=1 to ubound(fattura)
for y=2 to ubound(fattura)
[...]
 
in
 
for x=1 to ubound(fattura)
for y=X to ubound(fattura)
[...]
 
In questo modo, se non sbaglio, X e Y non potrebbero
mai avere lo stesso valore e quindi puntare alla
stessa fattura. E si risparmierebbe anche un bel po'
di cicli :-)
 
Bye, G.

 [...]
 
-- 
----- Italliaaaaa 3227! -----
Io sono Attila:
A come atrocità,
doppia T come terremoto e tragedia,
I come ira di dio,
L come laco ti sangue
e A come adesso vengo e ti sfascio le corna!
(Diego Abatantuono "Attila Flagello di Dio")
 
 

> [...]
 
Beh, in effetti è ora di caffè. Ben zuccherato :-).
 
Bye, G.

Hello Sauro,

Ciao,
solitamente questo è un problema di ricerca operativa e si risolve applicando 
il seguente algoritmo:
 
http://goo.gl/zyWRl
 
 
In rete vi sono diverse implementazioni.
Ciao, Stefano.
 
 

e cosi' via
 
Sbagliato!
 
ABCde ABcDe ABcdE AbCDe AbCdE AbcDE
aBCDe aBCdE aBcDE
abCDE
 
Verifica prima!!!

 ha
scritto:

In effetti il mio metodo troverebbe solo due fatture, se sono di più la cosa si
complica.
 
Per trovarlo devi fare un loop che prova tutte le possibili combinazioni e fa un
confronto dopo ogni somma.
 
La cosa è abbastanza complicata perchè dovresti confrontare il numero con
Fat(0)+Fat(1)   Fat(0)+Fat(2)   Fat(0)+Fat(3) ecc.
 
Poi
Fat(1)+Fat(2)  poi con  Fat(1)+Fat(3)
... fino a  Fat n
 
Poi
Fat(0)+Fat(1+)Fat(2)  poi con  Fat(0)+Fat(1+)Fat(3)  ... fino a  Fat (n)
 
Poi con
 
Fat(0)+Fat(1+)Fat(3) ... fino a  Fat(0)+Fat(1+)Fat(n)
 
Fat(0)+Fat(2+)Fat(3) ... fino a  Fat(0)+Fat(2+)Fat(n)
 
Finite le possibili combinazioni con Fat(0) proverai tutte le combinazioni
possibili con Fat(1), fregandotene de quelle che hai già fatto.
 
 
Finite le possibili combinazioni con Fat(1) proverai tutte le combinazioni
possibili con Fat(2) e ad un certo punto lo confronterai anche con:
 
Fat(2)+Fat(5)+Fat((7)
 
Certo che le combinazioni da provare diventano moltissime, con 8 più di 16
milioni (8^8), quindi il discorso di usare i Long è valido.
 
Non so se basta un loop nidificato o se conviene pensare a qualcosa di ricursivo
e non ho tempo di pensarci adessso.
 
 
--
ciao
  Stefano

 Sauro
 
Se ti interessa una versione VB.net...che fa uso di ricorsione....
la base è questa
http://stackoverflow.com/questions/127704/algorithm-to-return-all-combinations-of-k-elements-from-n
 
 
riadattato un po diventa
Public Class Form1
 
    Dim GOAL As Double = 0
    Dim ValMigliorDifetto As Double = 0
    Dim ValMigliorEccesso As Double = 0
    Private Sub Button1_Click(sender As System.Object, e As 
System.EventArgs) Handles Button1.Click
        Dim fatt(10) As Double
 
        fatt(0) = 112.34
        fatt(1) = 201.28
        fatt(2) = 103.73
        fatt(3) = 132.82
        fatt(4) = 183.92
        fatt(5) = 142.73
        fatt(6) = 192.77
        fatt(7) = 95.83
        fatt(8) = 121.21
        fatt(9) = 122.57
        fatt(10) = 99.99
        GOAL = fatt(2) + fatt(4) + fatt(7)
        'test bastardo....nessun goal possibile
        GOAL += 0.36
        Console.WriteLine("GOAL " + GOAL.ToString)
        Dim ArrayContenitore() As Double = fatt
        Dim profondita As UInteger = 0
        Dim Valori() As Double
 
        'loop per testare insiemi di numeri crescenti 2 3 4 5 ...n
        For n = 2 To fatt.Length
            profondita = n
            ReDim Valori(profondita - 1)
            If CreaCombinazioniArrayContenitore(Valori, 0, 
ArrayContenitore, 0) = True Then
                MessageBox.Show("BINGO! Valori trovati!")
                Exit Sub
 
            End If
 
        Next
        MessageBox.Show("Solo approssimazioni possibili!")
    End Sub
 
    Function CreaCombinazioniArrayContenitore(ByVal ArrayCombinazioni() 
As Double, ByVal IndiceCombinazioni As UInteger, ByVal ArrayGenerale() 
As Double, ByVal IndiceArrayGenerale As UInteger) As Boolean
        Dim somma As Double = 0
        If IndiceCombinazioni < ArrayCombinazioni.Length Then
            For i As Double = IndiceArrayGenerale To 
ArrayGenerale.Length - ArrayCombinazioni.Length + IndiceCombinazioni
                ArrayCombinazioni(IndiceCombinazioni) = 
ArrayGenerale(i)
                If CreaCombinazioniArrayContenitore(ArrayCombinazioni, 
IndiceCombinazioni + 1, ArrayGenerale, i + 1) = True Then
                    Return True
                End If
            Next
        Else
            somma = 0
            For Each tt As Double In ArrayCombinazioni
                Console.Write(tt.ToString + " ")
                somma += tt
 
            Next
            Console.Write("Somma: " + somma.ToString)
 
            If somma = GOAL Then
                Console.WriteLine(" ")
                Console.WriteLine("............GOAL 
RAGGIUNTO...........")
                Console.WriteLine("Fatture di importo: ")
                For Each tt As Double In ArrayCombinazioni
                    Console.WriteLine(tt.ToString)
                Next
 
Console.WriteLine(".....................................")
                Return True
            Else
                If somma > GOAL Then
                    If ValMigliorEccesso = 0 Then ValMigliorEccesso = 
somma
                    If somma < ValMigliorEccesso Then ValMigliorEccesso 
= somma
                End If
                If somma < GOAL Then
                    If ValMigliorDifetto = 0 Then ValMigliorDifetto = 
somma
                    If somma > ValMigliorDifetto Then ValMigliorDifetto 
= somma
                End If
            End If
 
            Console.Write(" approssimato per difetto" + 
ValMigliorDifetto.ToString + " per eccesso " + 
ValMigliorEccesso.ToString)
            Console.WriteLine()
        End If
        Return False
    End Function
 
 
 
End Class
 
 
c'ho messo un po di "fuffa" nel senso che:
 ci son double invece di string
 se non trova il goal, ti da il miglior valore possibile per eccesso e 
per difetto
 
l'algoritmo dovrebbe generare tutte le combinazioni(non è roba mia) 
PERO'
fa uso di ricorsione!
...nel mio pc viaggia parecchio veloce.... farlo con una matrice di 50 
elementi non so cosa accade....da quello che dicono in rete il vecchio 
vb6 si fermava a 120 ricorsioni (fattoriale 120!) per via del double 
che andava in overflow.
Credo che non ci dovrebbero essere problemi di ram!
 
 
se levi la bastardata sul goal che genera un numero impossibile da 
trovare ....
(e che comunque sul mio pc ci mette 15 20 secondi a stampare e ciclare 
tutto)
 
....vedi che ci mette 3 secondi a trovare il goal...se levi tutte le 
stampe che fa sull'output....è praticamente istantaneo!
 
non so se si può trasportare in vb6
...ad idea si....non ci vedo nulla di insormontabile:
 array.length è un Ubound(array)
 
 
Spero di avermi fatto perdonare le mie troppe cose date per scontate in 
buona fede(lo so tiscali che era sbagliato...c'era un "e così 
via"...cmq...grazie della precisazione!)
 
Salutos!
 
-- 
----- Italliaaaaa 3227! -----
Ho visto cose che voi umani non potreste immaginare... navi da 
combattimento in fiamme al largo dei bastioni di Orione. E ho visto i 
raggi B balenare nel buio vicino alle porte di Tannhauser. E tutti quei 
momenti andranno perduti nel tempo come lacrime nella pioggia. È tempo 
di morire...
 
Unità NEXUS6 Roy Batty N6MAA10816 Ment.LEV A
 
 

 
"Paperino" <non...@lo.dico.invalid> ha scritto nel messaggio 
news:jn69qs$s8n$1...@dont-email.me...

Ok funziona.
 
Fino a 10 fature pagate funziona in pochi minuti.
 
Avevo preparato il loop fino a 16 fatture, ma già
a 12 il risultato non ariva mai.
 
Grazie G.
 
Grazie anche a Wodka
 
Sauro 
 
 

Dopo dura riflessione, Wodka40° ha scritto :
ZACCHETE
Per i patiti del lotto supernealotto e per testare che genera tutte le 
combinazioni
 
Versione con stringhe
 
    Private Sub Button2_Click(sender As Object, e As System.EventArgs) 
Handles Button2.Click
        Dim m(0 To 9) As String
 
        m(0) = "A"
        m(1) = "B"
        m(2) = "C"
        m(3) = "D"
        m(4) = "E"
        m(5) = "F"
        m(6) = "G"
        m(7) = "H"
        m(8) = "I"
        m(9) = "L"
        Console.WriteLine("GENERAZIONE INSIEME DI " + m.Length.ToString 
+ " ELEMENTI")
        Dim ArrayContenitore() As String = m
        Dim profondita As UInteger = 0
        Dim Valori() As String
 
        'loop per testare insiemi di numeri crescenti 2 3 4 5 ...n
        For n = 1 To m.Length
            profondita = n
            ReDim Valori(profondita - 1)
            If STRINGCreaCombinazioniArrayContenitore(Valori, 0, 
ArrayContenitore, 0) = False Then
                Console.WriteLine("ELEMENTI SCELTI " + 
profondita.ToString)
                Console.WriteLine(".........................")
 
            End If
 
        Next
        MessageBox.Show("Generazione terminata!")
    End Sub
 
    Function STRINGCreaCombinazioniArrayContenitore(ByVal 
ArrayCombinazioni() As String, ByVal IndiceCombinazioni As UInteger, 
ByVal ArrayGenerale() As String, ByVal IndiceArrayGenerale As UInteger) 
As Boolean
        Dim somma As String = ""
        If IndiceCombinazioni < ArrayCombinazioni.Length Then
            For i As Double = IndiceArrayGenerale To 
ArrayGenerale.Length - ArrayCombinazioni.Length + IndiceCombinazioni
                ArrayCombinazioni(IndiceCombinazioni) = 
ArrayGenerale(i)
                If 
STRINGCreaCombinazioniArrayContenitore(ArrayCombinazioni, 
IndiceCombinazioni + 1, ArrayGenerale, i + 1) = True Then
                    Return True
                Else
 
                End If
            Next
        Else
            somma = ""
            For Each T As String In ArrayCombinazioni
                somma += T
            Next
            Console.WriteLine("-> " + somma)
 
        End If
        Return False
    End Function
 
Usa la ricorsione occhio....!
 
-- 
----- Italliaaaaa 3227! -----
Quando vedi la tua verità fiorire sulle labbra del tuo nemico, devi 
gioire, perché questo è il segno della vittoria.
(Giorgio Almirante)
 
 

Sauro
 
Metodo ultraveloce, configurabile (impostazione numero di fatture da 
ricercare) testato e perfettamente funzionante...
 
Option Base 1
 
Const Fatt = 100
Const NFatt = 4
 
Dim Fatture(100) As Currency
Dim Num() As Integer
 
Sub Main()
    Dim N As Long, N2 As Long, SubTot As Currency, Tot As Currency, Stringa 
As String
    ReDim Num(NFatt) As Integer
'Creo 100 fatture casuali
    For N = 1 To Fatt
        Fatture(N) = Int((1000000 * Rnd) + 1) / 100
    Next N
'Di queste ne prendo 3 a caso
    Stringa = "Importo da ricercare: "
    For N = 1 To NFatt
        N2 = Int((Fatt * Rnd) + 1)
        Tot = Tot + Fatture(N2)
        Num(N) = N
        Stringa = Stringa & " € " & Fatture(N2) & " (" & N2 & ") + "
    Next N
    Stringa = Left(Stringa, Len(Stringa) - 3) & " = €" & Tot & vbCrLf & 
vbCrLf
'Totale da ricercare
    N2 = NFatt - 1
    Do
        SubTot = 0
        For N = 1 To NFatt
            SubTot = SubTot + Fatture(Num(N))
        Next N
        If SubTot = Tot Then
'BINGO
            Stringa = Stringa & "Fatture: "
            For N = 1 To NFatt
                Stringa = Stringa & Num(N) & " (€ " & Fatture(Num(N)) & ") - 
"
            Next N
            Stringa = Left(Stringa, Len(Stringa) - 3) & vbCrLf
        End If
        Num(NFatt) = Num(NFatt) + 1
        If Num(NFatt) = Fatt + 1 Then
            Num(N2) = Num(N2) + 1
            For N = N2 + 1 To NFatt
                Num(N) = Num(N - 1) + 1
            Next N
            If Num(NFatt) > Fatt Then
1               N2 = N2 - 1
                If N2 = 0 Then
                    Exit Do
                Else
                    For N = N2 To NFatt
                        If N = N2 Then
                            Num(N) = Num(N) + 1
                        Else
                            Num(N) = Num(N - 1) + 1
                        End If
                    Next N
                End If
                If Num(NFatt) > Fatt Then GoTo 1
                N2 = NFatt - 1
            End If
        End If
    Loop
    MsgBox "Ricerca ultimata" & vbCrLf & vbCrLf & Stringa
End Sub
 

Ho dimenticato...
 
Per farlo funzionare basta che lo metti in un modulo e imposti il progetto 
per l'avvio con SUB MAIN.
 
PS: La routine ti tira fuori tutte le occorrenze che trova (perchè 
potrebbero essercene più d'una!!!) 
 

 a 12 il risultato non ariva mai.
 
Dovrebbe metterci molto meno, così ad occhiometro.
Puoi postare il codice ?
Oppure prova come dicevo nella risposta a Wodka,
per eliminare i continui controlli, diminuire
le addizioni e uscire da tutti i loop una volta
trovata la corrispondenza.
Pseudo codice, come al solito:
 
dim Trovato as Boolean
Dim Test1 as currency
Dim Test2 as currency
Dim Test3 as currency
Dim Test4 as currency
 
FOR X=1 to 50 'prima cifra
 TEST1=IMPORTI(X)
 if test1= goal then trovato=true
  if trovato then exit for
  for Y= X to 50 'seconda cifra, parte da quella
  ' subito dopo la X, così non possono essere uguali
    test2=test1+IMPORTI(Y)
    if test2= goal then trovato=true
     if trovato then exit for
      FOR z= Y to 50 'terza cifra, idem come sopra
       TEST3=test2+IMPORTI(Z)
       if test3= goal then trovato=true
    if trovato then exit for
   NEXT z
 NEXT y
NEXT x
 
Bye, G. 
 
 

 if test1= goal then trovato=true
 
OPS... !
Dimenticavo una cosa importante: qui, e negli
altri, bisognerebbe controllare if test1 > goal
e uscire da quel particolare for.
E' ovviamente inutile continuare quella serie
di controlli se abbiamo già superato la cifra
del pagamento.
 
Bye, G. 
 
 

 "Paperino" ha scritto
zac
 
Mi sono "redento" hai visto? Ho adattato al suo problema un algoritmo 
ricorsivo!
Se non trova goal gli da l'approssimazione migliore in eccesso e 
difetto
 
-- 
----- Italliaaaaa 3227! -----


Lo state affrontando nel modo sbagliato...
 
Metodo ultraveloce, configurabile (impostazione numero di fatture da
ricercare) testato e perfettamente funzionante...
 
Test con 100 importi e 5 fatture... una manciata di secondi!!!



 Bye, G.
 
Giusto, questo non l'avevo considerato.
Provvederò.
 
Ecco di seguito quanto da me poreparato:
 
Public Function Uguali(Long1 As Long, Long2 As Long, Centesimi As Long) As 
Boolean
'Fino a X centesimi di differenza potrebbero essere considerati uguali
If Long1 + Centesimi >= Long2 And Long1 - Centesimi <= Long2 Then
    Uguali = True
End If
End Function
 
 
Public Function StessaFattura(ByRef I() As Integer, Quanti As Integer) As 
Boolean
'Per scartare la medesima fattura su più loop
Dim x As Integer
Dim Fatti(1 To 50) As Boolean
For x = 1 To Quanti
    If Fatti(I(x)) Then
        StessaFattura = True
        Exit Function
    End If
    Fatti(I(x)) = True
Next x
End Function
 
 
Public Function QualiImporti(ByRef Ris() As Boolean, Importi() As Double, 
DES() As String, QuantiImporti As Integer, Somma As Double, CentesimiScarto 
As Long) As Boolean
'Ris = Boolean di 50 che avrà true per le fatture pagate
'Importi delle fatture
'DES per esempio: Fattura 100 del 01/04/2012
'QuantiImporti = numero di importi validi
'Somma = Importo del bonifico
Dim Im(1 To 50) As Long
Dim So As Long
Dim x As Integer
Dim I(1 To 25) As Integer
Dim u1 As Integer: Dim u2 As Integer: Dim u3 As Integer: Dim u4 As Integer: 
Dim u5 As Integer: Dim u6 As Integer
Dim u7 As Integer: Dim u8 As Integer: Dim u9 As Integer: Dim u10 As Integer: 
Dim u11 As Integer
Dim u12 As Integer: Dim u13 As Integer: Dim u14 As Integer: Dim u15 As 
Integer: Dim u16 As Integer
Dim Sol As String
Dim Totale As Double
So = Somma * 100
For x = 1 To QuantiImporti
    Im(x) = Importi(x) * 100
Next x
AFILLno Ris
For u1 = 1 To QuantiImporti
    I(1) = u1
    If Uguali(Im(I(1)), So, CentesimiScarto) Then
        Ris(I(1)) = True 'Una fattura pagata
        GoTo Trovato
    End If
    For u2 = 2 To QuantiImporti
        I(2) = u2
        If I(1) <> I(2) Then 'Altrimenti sarebbe la stessa fattura
            If Uguali(Im(I(1)) + Im(I(2)), So, CentesimiScarto) Then
                Ris(I(1)) = True: Ris(I(2)) = True 'Due fatture pagate
                GoTo Trovato
            End If
        End If
        For u3 = 3 To QuantiImporti
            I(3) = u3
            If I(1) <> I(2) And I(1) <> I(3) And I(2) <> I(3) Then 
'Altrimenti sarebbe la stessa fattura
                If Uguali(Im(I(1)) + Im(I(2)) + Im(I(3)), So, 
CentesimiScarto) Then
                    Ris(I(1)) = True: Ris(I(2)) = True: Ris(I(3)) = True '3 
fatture pagate
                    GoTo Trovato
                End If
            End If
            For u4 = 4 To QuantiImporti
                I(4) = u4
                If Not StessaFattura(I, 4) Then    'Altrimenti sarebbe la 
stessa fattura
                    If Uguali(Im(I(1)) + Im(I(2)) + Im(I(3)) + Im(I(4)), So, 
CentesimiScarto) Then
                        Ris(I(1)) = True: Ris(I(2)) = True: Ris(I(3)) = 
True: Ris(I(4)) = True '4 pagate
                        GoTo Trovato
                    End If
                End If
                For u5 = 5 To QuantiImporti
                    I(5) = u5: FrmQualiImporti.N(5) = I(5)
                    If Not StessaFattura(I, 5) Then
                        If Uguali(Im(I(1)) + Im(I(2)) + Im(I(3)) + Im(I(4)) 
+ Im(I(5)), So, CentesimiScarto) Then
                            Ris(I(1)) = True: Ris(I(2)) = True: Ris(I(3)) = 
True: Ris(I(4)) = True: Ris(I(5)) = True '5 pagate
                            GoTo Trovato
                        End If
                    End If
For u6 = 6 To QuantiImporti
    I(6) = u6
    If Not StessaFattura(I, 6) Then
        If Uguali(Im(I(1)) + Im(I(2)) + Im(I(3)) + Im(I(4)) + Im(I(5)) + 
Im(I(6)), So, CentesimiScarto) Then
            Ris(I(1)) = True: Ris(I(2)) = True: Ris(I(3)) = True: Ris(I(4)) 
= True: Ris(I(5)) = True: Ris(I(6)) = True '6 pagate
            GoTo Trovato
        End If
    End If
    For u7 = 7 To QuantiImporti
        I(7) = u7
        If Not StessaFattura(I, 7) Then
            If Uguali(Im(I(1)) + Im(I(2)) + Im(I(3)) + Im(I(4)) + Im(I(5)) + 
Im(I(6)) + Im(I(7)), So, CentesimiScarto) Then
                Ris(I(1)) = True: Ris(I(2)) = True: Ris(I(3)) = True: 
Ris(I(4)) = True: Ris(I(5)) = True: Ris(I(6)) = True: Ris(I(7)) = True '7 
pagate
                GoTo Trovato
            End If
        End If
        For u8 = 8 To QuantiImporti
            I(8) = u8
            If Not StessaFattura(I, 8) Then
                If Uguali(Im(I(1)) + Im(I(2)) + Im(I(3)) + Im(I(4)) + 
Im(I(5)) + Im(I(6)) + Im(I(7)) + Im(I(8)), So, CentesimiScarto) Then
                    Ris(I(1)) = True: Ris(I(2)) = True: Ris(I(3)) = True: 
Ris(I(4)) = True: Ris(I(5)) = True: Ris(I(6)) = True: Ris(I(7)) = True: 
Ris(I(8)) = True '8 pagate
                    GoTo Trovato
                End If
            End If
            For u9 = 9 To QuantiImporti
                I(9) = u9
                If Not StessaFattura(I, 9) Then
                    If Uguali(Im(I(1)) + Im(I(2)) + Im(I(3)) + Im(I(4)) + 
Im(I(5)) + Im(I(6)) + Im(I(7)) + Im(I(8)) + Im(I(9)), So, CentesimiScarto) 
Then
                        Ris(I(1)) = True: Ris(I(2)) = True: Ris(I(3)) = 
True: Ris(I(4)) = True: Ris(I(5)) = True: Ris(I(6)) = True: Ris(I(7)) = 
True: Ris(I(8)) = True
                        Ris(I(9)) = True '9 Pagate
                        GoTo Trovato
                    End If
                End If
                For u10 = 10 To QuantiImporti
                    I(10) = u10
                    If Not StessaFattura(I, 10) Then
                        If Uguali(Im(I(1)) + Im(I(2)) + Im(I(3)) + Im(I(4)) 
+ Im(I(5)) + Im(I(6)) + Im(I(7)) + Im(I(8)) + Im(I(9)) + Im(I(10)), So, 
CentesimiScarto) Then
                            Ris(I(1)) = True: Ris(I(2)) = True: Ris(I(3)) = 
True: Ris(I(4)) = True: Ris(I(5)) = True: Ris(I(6)) = True: Ris(I(7)) = 
True: Ris(I(8)) = True
                            Ris(I(9)) = True: Ris(I(10)) = True '10 Pagate
                            GoTo Trovato
                        End If
                    End If
                Next u10
            Next u9
        Next u8
    Next u7
Next u6
                Next u5
            Next u4
        Next u3
    Next u2
Next u1
Call MsgBox("Soluzione inesistente.", vbExclamation, App.Title)
Trovato:
Sol = "Mi sono fermato alla prima soluzione." & vbCrLf
Sol = Sol & "Potrebbero essercene altre." & vbCrLf
SoluzioneParziale:
For x = 1 To QuantiImporti
    If Ris(x) Then
        Sol = Sol & Vir(x, 2) & "    " & Mil(Importi(x), 16, 2) & "   " & 
DES(x) & vbCrLf
        Totale = Totale + Importi(x)
    End If
Next x
Sol = Sol & "Totale:   " & Mil(Totale, 12, 2) & vbCrLf
Sol = Sol & "Digitato: " & Mil(Somma, 12, 2) & vbCrLf
NelBoxMio Sol ' E' una mia routine di visualizzazione
QualiImporti = True
End Function
 
 

 potrebbero essercene piů d'una!!!)
 
[Cut routine]
 
Poi guardero' meglio la tua routine.
In ogni caso all'aumento di una sola fattura pagata
i tempi si moltiplicano per quante sono tutte
le fatture.
Per arrivare a 10 ... e oltre.
 
Ciao Tiscali
Sauro 
 
 

Correva il 27/04/2012 e rincorrendolo Sauro scriveva:
ma hai provato come ho fatto io?....i tempi sono umanissimi
Che mi fai reinstallare il vb6 ?????
 
-- 
----- Italliaaaaa 3227! -----
Ho trovato una città di mattoni, ve la restituisco di marmo.
(Imperatore Augusto da Epistole)
 
 

E' per questo motivo che va realizzata una routine ad hoc che sia moooolto 
veloce... il più possibile!!!
Ma se le fatture sono 50 e la ricerca si basa su 8 importi,
il tempo di elaborazione è di 45 secondi!!!
 

Ma se le fatture sono 50 e la ricerca si basa su 10 importi,
il tempo d'elaborazione sale a 18 minuti e 7 secondi!!!
 
Inoltre più fatture ci sono da ricercare (in questo caso 10) e più aumentano 
le corrispondenze,
quindi il test fallisce!!!
 
Il gioco riesce solo se sai quante sono le fatture da ricercare, altrimenti 
devi provare tutte le combinazioni fino a un massimo da te prefissato, se 
durante tutti i test otterrai un unico risultato,
potrai QUASI essere sicuro che si tratta di quella sequenza.
 
L'ottimizzazione che si può ancora fare è bloccare il processo se si trova 
più d'una corrispondenza! 
 

          GoTo Trovato
 
ARGH ! :-(((
 
Ora ci lavoro un pochino, poi ti posto la mia.
 
Bye, G.

Ho risolto.
Funziona in tempi accettabili.
 
Devo ringraziarti per avermi dato lo spunto risolutivo
(profondità 2, 3, ecc.)
 
Devo ringraziare anche Paperino che mi ha aiutato a
migliorare il codice rendendolo più veloce.
 
Ciao Vodka
Sauro