Newsgroup: it.comp.appl.access
Titolo: VBA: alberi e visite ricorsive....

Salve a tutti,
premetto di essere reduce dal vietn.... oppsss dalle visite ricorsive ad un
albero maledetto!
non ne vengo fuori
vi spiego cosa devo fare:
ho una tabella legami PADRE-FIGLIO del tipo
Padre    Figlio
1            2
1            3
1            4
2            5
2            6
.................
.................
.................
a seconda del livello gerarchico ogni nodo prende una
percentuale sui propri figli..... non riesco a visitare
in modo ricorsivo la struttura dell'albero
ho provato a scrivere la visita in mille modi senza venirne a capo
Potete darmi una dritta? qualche esempio da dove posso
prendere spunto?
grazie!
ringo

 news:b295dm$kbp$1...@lacerta.tiscalinet.it...
[...]

        Wirth, Niklaus _Algoritmi + Strutture dati = Programmi_
 
http://it-lang-vb.net/tablibri.asp?ID=350
--
Ciao :-)
Maurizio
--------
?SPQR(C)
 X
--------

 news:b295dm$kbp$1...@lacerta.tiscalinet.it...
[...]

        Wirth, Niklaus _Algoritmi + Strutture dati = Programmi_
 
http://it-lang-vb.net/tablibri.asp?ID=350
    (Se pero' tu dessi qualche informazione in piu' si potrebbe dare una
mano...)


ringo ha scritto:

ola Ringo. ma questa qual'era? la storia delle provvigioni
o meglio delle tangenti? 
Se era quella, dal modo in cui l'avevi messa, non mi sembrava
che ci fosse necessita' di gestire la ricorsivita' almeno
per la percentuale. Sempre se e' quella, nel tuo esempio,
mancano le foglie cioe' i record che sulla colonna figlio
hanno un null.
Probabilmente, invece, se oltre alla
percentuale hai anche il fatturato dei figli allora......
Cmq. come ti ha sollecitato Borrelli cerca di essere
meno parco di parole. Senza strafare pero'........
Siiiii. Ho controllato. Eri proprio tu il "tangentaro"!
nzomma te stai a fa sta distinta base!
Io la palla de vetro nun ce l'ho, ma una piccola 
previsione su questo problema l'avevo fatta.
Mo capisco pure la questione dell'array.
--
a.cara
togli qualcosa dall'email

 ha scritto nel messaggio
news:3E489D33...@blunet.it...

eh eh ......
Esatto hai centrato in pieno!
Allora vi spiego cosa devo fare:
- ho una tabella venditori
- ho una tabella PADRE-FIGLIO (tab. LEGAMI)
- ho una tabella FATTURE
- ho una tabella LIVELLI dove è associato ad ogni
livello la famosa "tangente provvigionale"
In sintesi occorre calcolare le provvigioni multilivello
di ogni venditore in base alla posizione gerarchica data dalla
tabella LEGAMI... mi server una funzioncina che prende uno
ad uno i venditori e scandaglia ricorsivamente il proprio
fatturato ed il fatturato dei propri figli.
Questo è il codice che ho scritto finora ma non riesco a
beccare la ricorsione esatta per fare la cosa.......
' Calcolo provvigioni sulle singole fatture con visita all'albero
stsql = "SELECT fatture.id_venditore, Sum(fatture.fatturato) AS fatturato, 0
AS provvigione FROM fatture GROUP BY fatture.id_venditore, 0; "
Set rs = db.OpenRecordset(stsql)
stsql2 = "select * from provvigioni"
Set rs2 = db.OpenRecordset(stsql2)
' rs2.MoveFirst
rs.MoveFirst
' ciclo sui vari venditori
Do Until rs.EOF
    rs2.AddNew
    rs2("id_venditore") = rs("id_venditore")
    rs2("provvigione") = visita(rs("ID_VENDITORE"), 0, rs("Fatturato"))
    rs2.Update
    rs.MoveNext
Loop
End Sub
Public Static Function conta_figli(ByVal padre As Integer)
Dim stsql As String
Dim rs As Recordset
Dim db As Database
Dim array_figli() As String
Dim i As Integer
Set db = CurrentDb
stsql = "select * from legami where cod_padre = " & padre & " ; "
Set rs = db.OpenRecordset(stsql)
rs.MoveLast
conta_figli = rs.RecordCount
'Memorizzazione ID venditori in un'array
ReDim array_figli(conta_figli)
rs.MoveFirst
'If conta_figli = 1 Then
'
'    array_figli(0) = rs("cod_figlio")
'    Debug.Print array_figli(0)
'
'    Else
        For i = 0 To conta_figli - 1
            array_figli(i) = rs("cod_figlio")
            Debug.Print array_figli(i)
            rs.MoveNext
        Next
'End If
conta_figli = array_figli(i)
rs.Close
End Function
Public Function fattore(ByVal livello As Integer)
Dim stsql As String
Dim rs As Recordset
Dim db As Database
Set db = CurrentDb
stsql = "select * from livelli where livello = " & livello & "  "
Set rs = db.OpenRecordset(stsql)
rs.MoveFirst
fattore = rs("fattore")
rs.Close
End Function
Public Function visita(ByVal agente As Integer, ByVal livello As Integer,
ByVal fatturato)
Dim guadagno As Integer
Dim importo_fattore, i As Integer
Dim quanti_figli As Variant
importo_fattore = fattore(livello)
visita = fatturato + (fatturato * importo_fattore) / 100
'quanti_figli = conta_figli(agente)
quanti_figli(0) = conta_figli(1)
Debug.Print quanti_figli
Debug.Print quanti_figli
For i = 1 To quanti_figli
  '  visita = visita + visita(
Next i
' Debug.Print guadagno
End Function

 ha scritto nel messaggio
news:b295vn$1apsgm$1...@ID-52090.news.dfncis.de...

Allora vi spiego cosa devo fare:


ringo wrote:
[cut]
Questa e' la cosa che ho prodotto
Questa cosa compresa fra i trattini devi aggiungerla come
modulo di classe di nome "clsTree"
-----------------------------------
Option Compare Database
Option Explicit
Dim Properties As New Collection
Private Sub Class_Initialize()
Properties.Add 0, "Value"
Properties.Add 0, "Level"
Properties.Add "", "Key"
End Sub
Property Get Count() As Long
    Count = Properties.Count
End Property
Property Get Key() As Variant
    Key = Properties("Key")
End Property
Property Let Key(pValue As Variant)
    Properties.Remove "Key"
    Properties.Add pValue, "Key"
End Property
Property Get Value() As Variant
    Value = Properties("Value")
End Property
Property Let Value(pValue As Variant)
    Properties.Remove "Value"
    Properties.Add pValue, "Value"
End Property
Function Add(pChild As Variant)
    Properties.Add pChild
End Function
Function Store(pKey As String, pImporto As Long)
    Value = pImporto
    Key = pKey
End Function
Function Evaluate(pLevel As Long, pFatt As Variant) As Long
Dim oTree As clsTree
Dim iFor As Long
Dim iLv As Long
iLv = pLevel + 1
For iFor = 4 To Properties.Count
    Set oTree = Properties(iFor)
    oTree.Evaluate iLv, pFatt
Next
pFatt(iLv) = pFatt(iLv) + Value
Evaluate = iLv
End Function
----------------------------
Il codice a seguire l'ho messo su un bottone
******************************************
Private Sub Esegui_Click()
Dim Provv As New Collection
Dim oVend As New clsTree
Dim oParent As clsTree
Dim rst As Variant
Dim sKey As String
Dim aPerc As Variant
Dim aFatt(10) As Long
Dim iFor As Long
aPerc = Array(0, 1.5, 2.5, 3.5, 4.5, 5.5) <----ho messo "tangenti" fisse
per comodita'
Set rst = Me.RecordsetClone
rst.MoveFirst
Do Until rst.EOF
    Set oVend = Nothing
    oVend.Store rst("idvend").Value, Nz(rst("Fatturato").Value, 0)
    Provv.Add oVend, rst("idvend").Value
    sKey = "" & rst("idpadre")
    On Error Resume Next
    If sKey <> "" Then
        Set oParent = Provv(sKey)
        If Err.Number <> 0 Then
            Set oParent = New clsTree
            oParent.Store sKey, 0
            Provv.Add oParent, sKey
        End If
        oParent.Add oVend
    End If
    On Error GoTo 0
    rst.MoveNext
Loop
Set rst = Nothing
Set oParent = Nothing
For Each oParent In Provv
    oParent.Evaluate 0, aFatt
    For iFor = 1 To UBound(aPerc)
      Debug.Print oParent.Key & "-" & aFatt(iFor) * aPerc(iFor)
      aFatt(iFor) = 0
    Next
 
Next
End Sub
*******************************************************
Per comodita' mia ho usato il recordset di maschera la query che ho
usato e' questa
++++++++++++++++++++++++++++++++++
SELECT RingoLegami.idVend, RingoLegami.idPadre, Sum(RingoFat.importo) AS
Fatturato
FROM RingoLegami LEFT JOIN RingoFat ON RingoLegami.idVend =
RingoFat.idvend
GROUP BY RingoLegami.idVend, RingoLegami.idPadre;
+++++++++++++++++++++++++++++++++++
Se hai bisogno di delucidazioni, scrivi
Ho testato il tutto e "sembra" funzionare
per come e' fatta la cosa potrebbe gestire fino a 10 livelli
--
a.cara 
Togli qualcosa dall'email

 ha scritto nel messaggio
news:3E58F995...@blunet.it...

Sei un mito Alessandro!!!
dopo la provo e ti sò dire.... adesso
sono preso dalle BOOOOMbe
a dopo
bye
ringo

 ha scritto nel messaggio
news:3E58F995...@blunet.it...

Alessandro mi si blocca su:
Provv.Add oVend, rst("cod_figlio").Value
"tipo non corrispondente..."
P.S.: volevo chiederti se è da tanto che programmi in VBA?
non è cosa da tutti usare i moduli di classe ed inoltre dai
risposte sempre altamente professionali! Ma dove lavori
alla NASA? :-) mi sento lontano anni luce dal tuo
stile di programmazione....
mi rendo conto di avere delle gravi lacune in ambito di
programmazione... non sono capace di usare la ricorsività
e tantomeno conosco la vera programmazione ad oggetti
ringo

 e tantomeno conosco la vera programmazione ad oggetti
Se il problema te lo poni ci riuscirai e bene sia a 
"programmare" che ad usare gli oggetti


 ha scritto nel messaggio
news:3E5A4A1C...@blunet.it...

Alessandro guarda quà :-)
2-52,5
2-50
2-0
2-0
2-0
1-0
1-137,5
1-70
1-0
1-0
3-15
3-0
3-0
3-0
3-0
4-15
4-0
4-0
4-0
4-0
5-15
5-0
5-0
5-0
5-0
6-15
6-0
6-0
6-0
6-0
7-0
7-0
7-0
7-0
7-0
il recordset è:
cod_padre cod_figlio fatturato
1                 2                 35
1                 3                 10
1                 4                 10
2                 5                 10
2                 6                 10
6                 7
le vendite sono:
id_venditore fatturato
1                      12
1                      12
2                      15
2                      20
6                      10
3                      10
4                      10
5                      10
i legami sono:
cod_padre cod_figlio
1                   2
1                   3
1                   4
2                   5
2                   6
6                   7
...devo fare 4 conti adesso per capire cosa  significa
l'output dei tuoi cicli.... ad oggetti.....
bye
ringo

 l'output dei tuoi cicli.... ad oggetti.....


 6                   7
stai attento. Se non metti su legami un entrata 
per 1 come figlio (con padre a null) ti perdi
il fatturato di 1.
Sta cosa gia' te la avevo accennata in un post
precedente.
Se non vuoi fare questo sei costretto a mettere
in join anche la anagrafica


 > > "programmare" che ad usare gli oggetti
molto saggio!......
e..... moooolto ottimista :-)
ringo