title image


Smiley Beispiel: Rekursive Summe einer Bilanzposition
Hi,



vielleicht mal ein Beispiel:



Bilanzpositionen haben eine baumartige Hierachie; z.B. Dispokredite werden der Forderungen zugeordnet etc. Jede Bilanzposition kann Kapitalien enthalten, die dann hierarchisch aufkumuliert werden sollen.



Das erledigt folgende Funktion:

Function BPAggregat(strSummenFeld as String, strTabelle as String) As Double

'rekursive Funktion

'liefert die Kapital- oder Zinssumme aus der angegebenen Tabelle über rekursiven Drilldown entlang der BP-Hierarchie.





Dim aryBPs() As String 'Array der Töchter der BP

Dim BP As Variant

Dim strKriterium As String

Dim rstDaten As DAO.Recordset



Set rstDaten = CurrentDb.OpenRecordset("SELECT Sum(" & strSummenFeld & ") As Wert FROM " & strTabelle)

BPAggregat = Nz(rstDaten!Wert) '<--- Feldname anpassen!

rstDaten.Close

Set rstDaten = Nothing

aryBPs = Split(BPTöchter(strBPWert), ";")

For Each BP In aryBPs

BPAggregat = BPAggregat + BPAggregat((BP), strBPFeld, strTabelle, strSummenFeld, strBSTWert, strBSTFeld, dteDatumWert, strDatumFeld)

Next BP

End Function





Die Funktion BPTöchter sucht die Tochterpositionen zu der gegebenen BP raus:



Function BPTöchter(strBP As String, Optional strDelim As String = ";", Optional blnTotal As Boolean = False) As String

'gibt die Tochter-BPs der übergebenen BP an, also die BPs, bei denen

'die übergebene BP als übergeordneter Schlüssel eingetragen ist.

'Bei mehreren Töchtern werden die Töchter durch den Delimiter getrennt

Dim rstBPs As DAO.Recordset

Dim strDummy As String



Set rstBPs = CurrentDb.OpenRecordset("SELECT * FROM Zuordnung_BIlanzpositionen ORDER BY Schluessel")

If Not rstBPs.EOF Then

rstBPs.MoveLast

End If

If rstBPs.RecordCount > 0 Then

rstBPs.MoveFirst

Do While True

rstBPs.FindNext "[übergeordneter Schluessel] = " & strBP

If rstBPs.NoMatch Then

'übergebene BP hat keine Töchter

Exit Do

Else

'übergebene BP hat Töchter

If blnTotal Then

'prüfen, ob die gefundene Tochter weitere Töchter hat

If BPTöchter(rstBPs!Schluessel, , False) "" Then

'gefundene Tochter hat eigene Töchter

strDummy = strDummy & strDelim & rstBPs!Schluessel & strDelim & BPTöchter(rstBPs!Schluessel, strDelim, False)

Else

'gefundene Tochter hat keine eigenen Töchter

strDummy = strDummy & strDelim & rstBPs!Schluessel

End If

Else

'Prüfung auf weitere Töchter kann entfallen. Tochter anfügen

strDummy = strDummy & strDelim & rstBPs!Schluessel

End If

'rstBPs.FindNext "[übergeordneter Schluessel] = " & strBP

End If

Loop

End If

rstBPs.Close

Set rstBPs = Nothing

'evtl. führendes Semikolon abschneiden

If Left$(strDummy, 1) = ";" Or Left$(strDummy, 1) = "," Then

strDummy = Right(strDummy, Len(strDummy) - 1)

End If

BPTöchter = strDummy

End Function







Wichtig ist der rekursive Aufruf in der BPAggregat in der feet markierten Zeile, und eine Struktur, die zu jeder BP die direkt übergeordnete BP enthält (jede BP verweist auf ihre Mutter-BP). Alles andere ergibt sich durch diese Rekursion.



Rekursive Hierarchien sind aber nix für Anfänger!!!!!



HTH

Martin








Martin
Atrus2711 ät gmx punkt net
Meine Beiträge zu MS Office betreffen stets Version 2000,
wenn nicht anders angegeben.




geschrieben von


Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: