Office中国论坛/Access中国论坛

标题: 一段按照页数自动更新页码的代码，感觉很简单的功能却写了这么长代码，是不是思路... [打印本页]

作者: 玉树TMD临风 时间: 2015-5-20 23:57
标题: 一段按照页数自动更新页码的代码，感觉很简单的功能却写了这么长代码，是不是思路...
有这么一个档案表，其中的页次是空白，现在需要把同一档号的记录按“文件级档号”顺序，自动更新页次。

更新前：
序号档号文件级档号形成日期页次页数
1 2015-001 2015-001.001 20150101    2
2 2015-001 2015-001.003 20150102    4
3 2015-001 2015-001.007 20150102    4
4 2015-001 2015-001.011 20150801    8
5 2015-001 2015-001.019 20150103    1
6 2015-001 2015-001.020 20150505    12
1 2015-002 2015-002.001 20150101    3
2 2015-002 2015-002.004 20150202    2
3 2015-002 2015-002.006 20150203    5
4 2015-002 2015-002.011 20150205    8
1 2015-003 2015-003.001 20150501    6

更新后：

序号档号文件级档号形成日期页次页数
1 2015-001 2015-001.001 20150101  1 2
2 2015-001 2015-001.003 20150102  3 4
3 2015-001 2015-001.007 20150102  7 4
4 2015-001 2015-001.011 20150801 11  8
5 2015-001 2015-001.019 20150103 19  1
6 2015-001 2015-001.020 20150505 20  12
1 2015-002 2015-002.001 20150101  1 3
2 2015-002 2015-002.004 20150202  4 2
3 2015-002 2015-002.006 20150203  6 5
4 2015-002 2015-002.011 20150205 11 8
1 2015-003 2015-003.001 20150501  9 6

看似很简单的功能，我写来写去发现都需要好长代码，有没有其他更简单的方法？

Function UpdateJsYs() '更新件数页数
Dim rst As ADODB.Recordset
Dim DHTMP As String, XHtmp As Integer, YCtmp As Integer '档号,序号，页次,序号
Set rst = New ADODB.Recordset
rst.Open "select * from 表2 order by 文件级档号", CurrentProject.Connection, 1, 3
rst.MoveFirst
Do While Not rst.EOF
If rst!档号 = Nz(DHTMP) Then  '同一个档号
rst!页次 = YCtmp + ystmp
rst!序号 = XHtmp
rst!文件级档号 = rst!档号 & "." & Format(rst!页次, "000")
Else '档号不同
rst!页次 = 1
rst!序号 = 1
rst!文件级档号 = rst!档号 & ".001"
XHtmp = 1 '序号
End If
DHTMP = rst!档号
YCtmp = rst!页次
ystmp = rst!页数
XHtmp = XHtmp + 1 '序号
rst.MoveNext
Loop

End Function

作者: todaynew 时间: 2015-5-21 09:52
本帖最后由 todaynew 于 2015-5-21 10:58 编辑

有呀，用三个更新查询即可：
Dim ssql As String
ssql = "update 表2 set 页次=1 where 序号=1"
CurrentDb.Execute ssql

ssql = "update 表2 set 页次="
ssql = ssql & "DLookUp('页次','表2','档号=""' & [档号] & '"" and 序号=1')"
ssql = ssql & "+DSum('页数','表2','档号=""' & [档号] & '"" and 序号<' & [序号])"
ssql = ssql & " where 序号>1"
CurrentDb.Execute ssql

ssql = "update 表2 set 文件级档号=档号 & '.' & format(页次,'000')"
CurrentDb.Execute ssql

如果用ado处理，则可以用两个循环处理：
Function UpdateJsYs()
Dim rst1 As new ADODB.Recordset,rst2 As new ADODB.Recordset
dim ssql as string
dim i as long,j as long
dim cnt as long

ssql="select distinct 档号 from 表2"
rst1.Open ssql, CurrentProject.Connection, 1, 3
for i=1 to rst1.RecordCount  '按档号循环
      ssql="select * from 表2 where 档号='" & rst1!档号.value & "' order by 序号"
      rst2.Open ssql, CurrentProject.Connection, 1, 3
      cnt=0
      for j=1 to rst2.recordcount
         if j=1 then
            rst2!页次.value=1
         else
            rst2!页次.value=cnt
         end if
         rst2!文件级档号.value=rst2!档号 & "." & Format(rst2!页次, "000")
         rst2.update
         '用cnt保存本条记录的页次与页数之和，准备赋值给下一条记录的页次
         '也可将写为：cnt=cnt+rst2!页数.value，同时将rst2!页次.value=cnt改为rst2!页次.value=cnt+1
         cnt=rst2!页次.value+rst2!页数.value
         rst2.movenext
      next
      rst2.close
      rst1.movenext
next
set rst2=nothing
rst1.close:set rst1=nothing
End Function

作者: 玉树TMD临风 时间: 2015-5-26 20:56
第一个代码有意思，一时还看不清楚，回头测试一下。

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