Office中国论坛/Access中国论坛

标题: 如何按树的上下顺序重新编号 [打印本页]

作者: 付谦 时间: 2021-4-9 14:10
标题: 如何按树的上下顺序重新编号
本帖最后由付谦于 2021-4-10 08:03 编辑

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

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

作者: aslxt 时间: 2021-4-11 09:00
递归的就不给你了,给一个模拟方向键也达到目的的方法,见附件

作者: 付谦 时间: 2021-4-11 12:15
本帖最后由付谦于 2021-4-11 12:17 编辑

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

作者: aslxt 时间: 2021-4-11 13:03
本帖最后由 aslxt 于 2021-4-11 13:16 编辑

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

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

作者: 付谦 时间: 2021-4-11 14:18
加上PtrSafe,改成　Public Declare PtrSafe Function timeGetTime Lib "winmm.dll" () As Long　可以了
再次感谢ASLXT!

作者: 付谦 时间: 2021-4-11 16:17
ASLXT大师:
　　我树图共19000条记录,按上述方法共花了21分钟,是否还有其他方法提高速度?

作者: aslxt 时间: 2021-4-11 17:03
本帖最后由 aslxt 于 2021-4-11 17:09 编辑

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

作者: 付谦 时间: 2021-4-11 17:47
递归不会,大师能否帮助,谢!

作者: aslxt 时间: 2021-4-11 21:28
新建窗体,新建按钮(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 时间: 2021-4-11 21:30
建议:表中再增加"排行"字段,重编码,生成树,输出到Excel/Word/visio等更方便.

作者: 付谦 时间: 2021-4-12 09:07
感谢aslxt 大师助人为乐!帮我解决了大难题

作者: 付谦 时间: 2021-4-12 09:08
感谢aslxt 大师助人为乐!帮我解决了大难题

作者: 付谦 时间: 2021-4-12 09:09
感谢aslxt 大师助人为乐!帮我解决了大难题

作者: 付谦 时间: 2021-4-12 09:11
感谢aslxt 大师助人为乐!帮我解决了大难题

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)