![]() |
#2
风吹过b2017-08-09 11:01
百度到一个函数,你自己测试一下吧。
'============================================================================================================================ '-函数名称: AutoNum '-功能描述: 具有断号重续功能的自动编号函数,支持文本型和长整型数值的自动编号 '-输入参数: 参数1:TableName 必需的,表名 ' 参数2:FieldName 必需的,自动编号字段名 ' 参数3:Prefixal 可选的,编号前缀,编号字段数据类型为文本时才起作用 ' 参数4:Digit 可选的(文本型编号时为必需),文本型编号位数(不包含前缀的) ' 参数5:SerialNumber 可选的,设为true时使用断号重续,设为false时不理会断号,只在已有最大编号上加1 '-其它说明: 使用文本型自动编号时,如果记录数目可能会比较大时,建议使用含有日期的前缀或将编号位数设大一些,否则如果达到编号 ' 上限将不能添加记录 ' '-使用注意: 调用的自动编号字段必须设置唯一索引,并且不能允许为空,最好是作为主键使用 '-返回参数: 正常情况下返回从1开始的最小断号,如无断号返回最大号加1;出错时返回Null '-兼 容 性: 字段的数据类型必须为文本型或者长整型数值,如设成其它均会只返回Null '-使用示例: Me.OrderID.DefaultValue="""" & AutoNum("Orders","OrderID","OD" & Format(Date(),"yyyymm"),5) & """" ' 返回值:OD19910100001,OD19910100002,OD19910400001,…… '-相关调用: '-作 者: 红尘如烟 '-创建日期: 20010-4-25 '============================================================================================================================= Function AutoNum(TableName As String, FieldName As String, _ Optional Prefixal As String, Optional Digit As Integer, _ Optional SerialNumber As Boolean = False) As Variant On Error GoTo Err_AutoNum Dim strSQL As String Dim intDataType As Integer Dim rst As DAO.Recordset Dim strErrMsg As String Dim intI As Integer Dim strExpr As String If TableName = "" Or FieldName = "" Then Err.Raise 3265 If TableName Like "[[]*]" Then TableName = Mid$(TableName, 2, Len(TableName) - 2) If FieldName Like "[[]*]" Then FieldName = Mid$(FieldName, 2, Len(FieldName) - 2) strExpr = Prefixal strExpr = Replace(strExpr, "'", "''") intDataType = CurrentDb.TableDefs(TableName).Fields(FieldName).Type If intDataType = 10 Then If Digit < 1 Then Err.Raise 1, , "文本型自动编号的编号位数不能小于1位。" If SerialNumber Then strSQL = "SELECT (Right([" & FieldName & "]," & Digit & ")+0) AS Expr1000 FROM [" & TableName & "] " & _ "WHERE Left([" & FieldName & "]," & Len(Prefixal) & ")= '" & strExpr & "' " & _ "ORDER BY (Right([" & FieldName & "]," & Digit & ")+0);" Else strSQL = "SELECT Max(Right([" & FieldName & "]," & Digit & ")+0) AS Expr1000 FROM [" & TableName & "] " & _ "WHERE Left([" & FieldName & "]," & Len(Prefixal) & ")= '" & strExpr & "';" End If ElseIf intDataType = 4 Then If SerialNumber Then strSQL = " SELECT [" & FieldName & "] AS Expr1000 FROM [" & TableName & "] ORDER BY [" & FieldName & "];" Else strSQL = " SELECT Max([" & FieldName & "]) AS Expr1000 FROM [" & TableName & "];" End If Else Err.Raise 2, , "不支持此数据类型的自动编号。" End If ' Debug.Print strSQL Set rst = CurrentDb.OpenRecordset(strSQL) If rst.RecordCount = 0 Then AutoNum = 1 Else If SerialNumber Then rst.MoveLast If rst!Expr1000 = rst.RecordCount Then AutoNum = rst.RecordCount + 1 Else rst.MoveFirst For intI = 1 To rst.RecordCount If rst!Expr1000 <> intI Then AutoNum = intI Exit For Else rst.MoveNext End If Next End If Else AutoNum = Nz(rst!Expr1000, 0) + 1 End If End If If intDataType = 10 Then If Len(AutoNum) > Digit Then Err.Raise 3, , "自动编号已达最大上限,不能再添加记录。" Else AutoNum = Prefixal & Format$(AutoNum, String$(Digit, "0")) End If End If Exit_AutoNum: Set rst = Nothing Exit Function Err_AutoNum: AutoNum = Null Select Case Err Case 3265 strErrMsg = "指定的表名或字段名不存在。" Case Else strErrMsg = Err.Description End Select MsgBox "#" & Err & vbCrLf & strErrMsg, vbCritical, "自动编号函数出错" Resume Exit_AutoNum End Function 转至《Office中国论坛》 ------------------- 我想到的是对整个数据库的数据重新更新,编排序号。 你的不重复关键字,没有确定,只能以序号来确定,所以这个编排序号,需要倒序进行。 指针移最后 N=取记录条数 do while 数据库不是在头 or N>0 更新序号为 N n=N-1 指针向前移 loop 一句话,时间都要花费很长的时间,随着数据库的增长,这个时间会越来越长。 ------- 我的电脑上不装 MS OFFICE 了,所以你的程序我无法调试。 另外,所有的变量都强烈建议申明,一是选项里开这个选项,二是代码窗口第一行凡没有 Option Explicit 这句的,手动补上。可以免去很多麻烦。 ------------- 问一句,为啥要排数据库里的序号? [此贴子已经被作者于2017-8-9 11:03编辑过] |
可以选择ListView1中的多项内容,点击删除后,对应的Access数据库的数据,也一并删除。
同时,Access数据中的序号,重新按顺序编号。
求解,谢谢! 附件:
只有本站会员才能查看附件,请 登录