Question

access 排序后怎么重新自动编号

现有一个表，表中ID为自动编号，可因为误操作，把原ID为自动编号的字段删除后，后又加上了一个ID为自动编号的字段，可顺序和原来的不一样了，不是按日期的升请问怎样做可以重新按日期自动重新编号。

Answer 1

需要用sql语句来处理。

比如原表数据如下：

现在要按出生日期从早到晚排列，并给出序号：

sql语句如下：

select t.* from
(select t1.*,(select count(*)+1 from 表2 as t2 where t2.出生日期<t1.出生日期) as 序号 from 表2 as t1) as t
order by 序号;

结果

Answer 2

先新增一个编号字段, 用vba打开记录集, 按事件排序, 做循环, 对编号字段赋值, 然后在表设计里把这个字段改成自动编号字段

追问

求详细方法，比如我现在表中只有两个字段，一个[ID]为自动编号，一个[日期]为日期型。？

追答

步骤我不是都写清楚了吗, 再详细就直接写代码了

追问

就是要代码，初学，不太懂。想看看实例。不知道可不可以。。。

追答

并不是所有步骤都要代码

1. 先新增一个编号字段,  这步设计数据表即可, 不需要代码

2. 用vba打开记录集, 按事件排序, 做循环, 对编号字段赋值,   这一步需要代码实现

3. 然后在表设计里把这个字段改成自动编号字段   这步设计数据表即可, 不需要代码
   

   我建议你自己研究一下

追问

主要是VBA代码不知道怎么写。不知道如果用VBA排序啊。~~
就是想要代码学习啊。~~
一个[ID]为自动编号，一个[日期]为日期型表名为LIST。
还有，赋值后的字段不可以转为自动编号吧？

追答

Sorry, 刚才测试了一下, 任何字段都不能在有赋值的请看下转变成自动编号字段的主键, 所以抱歉我的办法行不通, 误导你了
另外建议一个办法, 建一个新表, 设好自动编号字段, 然后把这个表记录按所需排序排好, copy到新表中, 这个办法不需要写代码, 设计操作界面就可以完成了, 试一下

追问

这个我试过了。自动编号是可以，但排序还是不可以，虽然先排好了，但复制过去后还不是排序好的顺序。直接复制的话，日期型字段不可复制。

Answer 3

'============================================================================================================================
'-函数名称： 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中国论坛》