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

付谦

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

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

aslxt

递归的就不给你了,给一个模拟方向键也达到目的的方法,见附件

付谦

谢ASLXT!就是要这效果.
因我是64位系统,模块中Public Declare Function timeGetTime Lib "winmm.dll" () As Long　为红色,
提示curNode未定义,
树也加载不了,
我不知道语句如何改,
请继续帮助

aslxt

那你试一下另一个,都是等待给定时间后在往下执行的意思
Private Declare Sub Sleep Lib "kernel32" (ByVal dwmilliseconds As Long)

使用  :sleep 50再重新引用树控件,重画树控件

付谦

加上PtrSafe,改成　Public Declare PtrSafe Function timeGetTime Lib "winmm.dll" () As Long　可以了
再次感谢ASLXT!

付谦

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

aslxt

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

付谦

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

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

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