如何按树的上下顺序重新编号

付谦

见附件
表记录字段:族人代码,承上码,世代,姓名,重编号
从前表记录是按照世代的先后顺序编号的(族人代码),现在想按照树的上下顺序重新编个号,为此在表中建立了重编号字段,点击"按树上下顺序编号"命令按钮,实现重编号字段是按树上下顺序编的号,如1,2,3......

网上说用递归可以做到,我对递归知识一点不懂,无从入手.请高手帮助

付谦

感谢aslxt 大师助人为乐!帮我解决了大难题

付谦

感谢aslxt 大师助人为乐!帮我解决了大难题

付谦

感谢aslxt 大师助人为乐!帮我解决了大难题

付谦

感谢aslxt 大师助人为乐!帮我解决了大难题

aslxt

建议:表中再增加"排行"字段,重编码,生成树,输出到Excel/Word/visio等更方便.

aslxt

新建窗体,新建按钮(Command0),代码如下:

Private Sub Command0_Click()
    开始重编号
End Sub

Function Conn() As ADODB.Connection    '仅为了其他地方书写方便
    Set Conn = CurrentProject.Connection
End Function

Function 开始重编号()
    Dim Rec As New ADODB.Recordset, i, sql, str, maxID
    sql = "update 族人信息 set 重编号=0,新承上码=0"    '清空字段
    Conn.Execute sql
    sql = "select * from 族人信息 where nz(承上码,0)=0 order by 世代,族人代码"    '选择没有承上码或=0的,表示他为始祖
    Rec.Open sql, Conn, adOpenStatic, adLockReadOnly
    For i = 1 To Rec.RecordCount
        maxID = DMax("重编号", "族人信息")    '获得已有的新编码的最大值
        sql = "update 族人信息 set 重编号=" & maxID + 1 & " where 族人代码=" & Rec!族人代码    '根节点无须更新[新承上码]
        Conn.Execute sql
        递归重编号 Rec!族人代码    '调用递归函数
        Rec.MoveNext
    Next i
End Function

Function 递归重编号(CSM)
    Dim Rec As New ADODB.Recordset, i, sql, str, maxID, newCSM
    sql = "select  * from 族人信息 where 承上码=" & CSM & " order by 族人代码"    '只是打开承上码等于参数CSM的记录
    Rec.Open sql, Conn, adOpenStatic, adLockReadOnly
    For i = 1 To Rec.RecordCount
        maxID = DMax("重编号", "族人信息")    '获得已有的新编码的最大值
        newCSM = DLookup("重编号", "族人信息", "族人代码=" & CSM)    '获得CSM参数代表的成员的新编码
        sql = "update 族人信息 set 重编号=" & maxID + 1 & ",新承上码=" & newCSM & " where 族人代码=" & Rec!族人代码
        Conn.Execute sql
        递归重编号 Rec!族人代码    '调用自己,这就是递归
        Rec.MoveNext
    Next i
End Function

付谦

递归不会,大师能否帮助,谢!

aslxt

递归要快一些,1:5左右

付谦

ASLXT大师:
　　我树图共19000条记录,按上述方法共花了21分钟,是否还有其他方法提高速度?