【Access小品】越俎代庖 --- 遞歸函數(shù)示例

todaynew

　　越俎代庖這個成語中有兩個角色，一個是神漢一個大廚，意思是說在祭祀活動中神漢和大廚是有分工的，神漢不應(yīng)直接代替大廚的工作。在Vba中實(shí)現(xiàn)一些功能，也有兩種東西，一個叫做子程序（Sub），一個叫做函數(shù)（Function）。子程序用來完成某些動作，函數(shù)用來返回需要的數(shù)據(jù)，通常來說這樣理解沒什么大的問題。不過有時候我們需要用函數(shù)來越俎代庖，實(shí)現(xiàn)子程序完成某些動作的功能。

　　從道理上講，函數(shù)是可以替代子程序的。原因在于函數(shù)體和子程序體的構(gòu)成是沒有什么大的差別的，唯一不同的是函數(shù)體中可以存在一條返回?cái)?shù)據(jù)的語句。也就是說子程序能實(shí)現(xiàn)的功能，函數(shù)都是可以實(shí)現(xiàn)的。而函數(shù)能實(shí)現(xiàn)的功能，子程序并不一定都能實(shí)現(xiàn)。這樣說來，子程序的存在只是為了保留一種概念上的功能區(qū)分。

　　版友付謙同志昨日里問了一個關(guān)于家譜用TreeView呈現(xiàn)方面的問題。我們知道家譜是一個不定級的層次結(jié)構(gòu)，最適于用遞歸的方法來得到一個樹形結(jié)構(gòu)。所以我們通�？梢杂靡粋�遞歸子程序來實(shí)現(xiàn)TreeView節(jié)點(diǎn)的加載。假如我們希望在每個節(jié)點(diǎn)上，反映出這個節(jié)點(diǎn)的所有后代成員的總數(shù)，這就不是一個簡單的事情了。說它不簡單，是因?yàn)樗�所要做的動作是向�?jié)點(diǎn)的Text屬性寫入一個統(tǒng)計(jì)出來的數(shù)據(jù)，遞歸動作本身比較難以統(tǒng)計(jì)這個數(shù)據(jù)。在這個特定的情況下，遞歸子程序比較難以實(shí)現(xiàn)邊統(tǒng)計(jì)邊寫入的功能。

　　怎么辦呢？答案很簡單，將遞歸子程序改為遞歸函數(shù)，這個問題就很簡單的可以解決了。函數(shù)是可以一邊做一些動作，一邊進(jìn)行計(jì)算并返回?cái)?shù)據(jù)的，這些返回的數(shù)據(jù)可以容易的參與遞歸運(yùn)算。我們可以將代碼大體寫成如下：

Private Function SetNodes(ByRef tree As TreeView, ByRef n As Node) As Long
    Dim cn As Node
    Dim rs As New ADODB.Recordset
    Dim ssql As String
    Dim i As Long
    Dim cnt As Long

    ssql = "select * from 族人信息 where " & n.Tag
    rs.Open ssql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic

    cnt = rs.RecordCount
    For i = 1 To rs.RecordCount
        Set cn = tree.Nodes.Add(n.Key, 4, "b" & rs!族人代碼.Value, rs!姓名.Value)
        cn.Tag = "nz(父代碼,0)=" & rs!族人代碼.Value
        '遞歸運(yùn)算
        cnt = cnt + SetNodes(tree, cn)
        rs.MoveNext
    Next
    '寫入節(jié)點(diǎn)的Text屬性
    n.Text = n.Text & " (" & n.Children & "/" & cnt & ")"

    SetNodes = cnt

    rs.Close: Set rs = Nothing
    Set cn = Nothing
End Function


示例：

視圖：

風(fēng)中漫步

謝謝分享.

付謙

謝todaynew 大師，與君一席話，勝讀十年書。

13601812106_01

請問todaynew大師在子窗體中，怎么按照遞歸的直接層別排序。建個臨時表，想了半天，也搞不出，能否做個例子，達(dá)到如下效果

層次 族人代碼 世代 姓名 關(guān)系
4 20226 24 楊云 長子
5 20228 25 楊琳 長女
5 20229 25 楊瓊 次女
5 20230 25 楊澤 之子
4 20227 24 劉菊 配
4 20231 24 楊妹 之女
4 20232 24 楊許 次子
5 20234 25 楊鵬順 之子
4 20233 24 曾艷 配

todaynew

13601812106_01 發(fā)表于 2015-6-10 15:47
請問todaynew大師在子窗體中，怎么按照遞歸的直接層別排序。建個臨時表，想了半天，也搞不出，能否做個例子 ...

很簡單嘛
1、將表中的查詢標(biāo)識字段的數(shù)據(jù)類型修改為文本型；

2、子窗體數(shù)據(jù)源修改為：SELECT * FROM 族人信息 ORDER BY 查詢標(biāo)識, 族人代碼;

3、將子程序FormFilter和SetWh做如下修改：
Private Sub FormFilter()
    Dim n As Node
    Dim wh As String
    Dim pid As Long
   
    Set n = Me.TreeView0.SelectedItem
    wh = "false"
    If Me.選項(xiàng).Value = 1 Then
        wh = n.Tag
    Else
        CurrentDb.Execute "update 族人信息 set 查詢標(biāo)識=Null"
        pid = Val(Mid(n.Key, 2))
        Call SetWh(pid, "00")
        wh = "nz(查詢標(biāo)識,'')<>''"
    End If
    Me.子窗體.Form.Filter = wh
    Me.子窗體.Form.FilterOn = True
    Set n = Nothing
End Sub

Private Sub SetWh(ByVal pid As Long, ByVal num As String)
    Dim ssql As String
    Dim rs As New ADODB.Recordset
    Dim i As Long
    Dim str As String

    ssql = "select * from 族人信息 where 父代碼=" & pid & " order by 族人代碼"
    rs.Open ssql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    For i = 1 To rs.RecordCount
        rs!查詢標(biāo)識.Value = num & Format(i, "00")
        rs.Update
        Call SetWh(rs!族人代碼.Value, rs!查詢標(biāo)識.Value)
        rs.MoveNext
    Next
   
    rs.Close: Set rs = Nothing
End Sub

13601812106_01

todaynew 大師，改寫的代碼也那么優(yōu)美，真應(yīng)開個專欄，讓更多的人來學(xué)習(xí)

13601812106_01

todaynew 發(fā)表于 2015-6-10 20:48
很簡單嘛
1、將表中的查詢標(biāo)識字段的數(shù)據(jù)類型修改為文本型；

todaynew大師，可以再改造一下嗎，目的是輸入方便：
1,把一張表，分為兩張，一為族人表，二為族人信息表，
2族人信息表中，沒有父代碼為空的。
3’樹控來源為族人表，子窗體來源于族人信息表
附件中，我已做好，就是不知道怎么改，這方面實(shí)在太差

todaynew

13601812106_01 發(fā)表于 2015-6-12 10:37
todaynew大師，可以再改造一下嗎，目的是輸入方便：
1,把一張表，分為兩張，一為族人表，二為族人信息表 ...

多此一舉，呵呵。我不想費(fèi)功夫做無意義的事情。

nncchh

學(xué)習(xí)學(xué)習(xí)，謝謝分享！ 學(xué)習(xí)學(xué)習(xí)，謝謝分享！ #在這里快速回復(fù)#

nncchh

學(xué)習(xí)學(xué)習(xí)，謝謝分享！