【源码示例】高效无重复自动编码解决方案

红尘如烟

一般自动编号功能，是先取得表中的已有最大号，然后在此基础上加1，如果每次生成编号都要从表中去取得最大编号，也就意味着每次生成编号都需要查询表中所有的记录，如果表中数据量很大，如有十万条以上，那么性能就很差了。（当然数据库引擎会有优化，但再优化总归是有限的）。并且这种方法在多用户同时录入时，存在生成重复编号的问题。

    本示例采用的方式为：调用GetNewID函数时，从编码表（USysSN）中读取指定编号字段对应的编号记录，如果记录为空，则先从原表中读取最大编号写入到该记录中；如果记录不为空，则读取该记录中的编号，并加1生成新编号，同时将编码表中的编号更新为新生成的编号。这样每次生成编号时只需要查询编码表中的很少的记录即可，并且由于生成的编号和原表无关，还可以防止多用户同时录入时生成重复编号的问题。

    假设某个表中有10万条记录，那么直接读取表生成新编号的方式需要查询10万条记录，而使用编码表的方式则每次只需要查询编码表中的几十条记录。

1. 
   
2. '============================================================================================================================
   
3. '-函数名称：    GetNewID
   
4. '-功能描述：    高效率的文本型自动编号函数，除了第一次调用，以后每次生成编号时不需要再访问编号字段所在的表，因此效率非常高，
   
5. '               表中数据量越大，效果越明显。并且在多用户环境下，也不会出现多个用户基于一个表同时录入时，会出现的编号重复问
   
6. '               题。适用于各种单据的编号及流水码等，具体请参考使用示例。
   
7. '-输入参数：    TableName       必需的，表名称或查询名称。
   
8. '               FieldName       必需的，自动编号字段名。
   
9. '               Digit           必需的，不包含前缀的序号位数。
   
10. '               Prefixal        可选的，编号前缀字符串，除了单据类型的描述字符，还可以把其它信息要素如部门ID等加入到此参数中。
    
11. '               DateFormat      可选的，编号中的日期部分格式，具体使用请参考Format函数中关于日期的数的部分说明。
    
12. '-其它说明：    必需要有一个编号维护表配合使用，表名称：USysSN 字段：TableName|FieldName|LastID ,3个字段均为文本型，大小60。
    
13. '-使用注意：
    
14. '-返回参数：    返回生成的编号，出错时返回空字符串（""）。
    
15. '-兼 容 性：
    
16. '-使用示例：    =GetNewID("Orders","OrderID",5,"XS","yymmdd")     返回示例：XS01042500004
    
17. '               =GetNewID("Orders","OrderID",5,"XS","-yyyymmdd-") 返回示例：XS-20100425-00004
    
18. '               =GetNewID("Orders","OrderID",5,"XS")              返回示例：XS00004
    
19. '               =GetNewID("Orders","OrderID",5,"XS","-")          返回示例：XS-00004
    
20. '               =GetNewID("Orders","OrderID",5)                   返回示例：00004
    
21. '               =GetNewID("Orders","OrderID",5,"【售】")          返回示例：【售】00004
    
22. '-相关调用：
    
23. '-作    者：    红尘如烟
    
24. '-创建日期：    2011-1-25
    
25. '=============================================================================================================================
    
26. Function GetNewID(TableName As String, FieldName As String, Digit As Integer, _
    
27.                     Optional Prefixal As String, Optional DateFormat As String) As String
    
28.     On Error GoTo Err_GetNewID
    
29.     Dim strDate     As String
    
30.     Dim strLastID   As String
    
31.     Dim strSN       As String
    
32.     Dim strWhere    As String
    
33.    
    
34.     If DateFormat <> "" Then strDate = Format$(Date, DateFormat)
    
35.     strSN = String$(Digit, "0")
    
36.     strWhere = "TableName='" & TableName & "' AND FieldName='" & FieldName & "'"
    
37.     strLastID = Nz(DLookup("LastID", "USysSN", strWhere))
    
38.    
    
39.     If strLastID = "" Then
    
40.         strLastID = Nz(DMax(FieldName, TableName), strSN)
    
41.         CurrentDb.Execute "DELETE FROM USysSN WHERE " & strWhere
    
42.         CurrentDb.Execute "INSERT INTO USysSN(TableName,FieldName) " & _
    
43.                           "VALUES('" & TableName & "','" & FieldName & "')"
    
44.     End If
    
45.    
    
46.     strLastID = Prefixal & strDate & Format$(Val(Right$(strLastID, Digit)) + 1, strSN)
    
47.     CurrentDb.Execute "UPDATE USysSN SET LastID='" & strLastID & "' WHERE " & strWhere
    
48.     GetNewID = strLastID
    
49.    
    
50. Exit_GetNewID:
    
51.     Exit Function
    
52.    
    
53. Err_GetNewID:
    
54.     GetNewID = ""
    
55.     MsgBox Err.Description, vbCritical, "Error #" & Err
    
56.     Resume Exit_GetNewID
    
57. End Function
    

复制代码

向小庞

了解

qbtan85

谢谢分享

YXH_YXH

下载学习，谢谢分享！

tmtony

好贴。我也是使用这种方法。也是加了日期和前缀。不过，我还应用户需要加了个后缀。另外增加了一个顺序有多少位 及总长度多少位的控制。
看来，做到最后，大家都想到一块去了。

红尘如烟

ycxchen 发表于 2011-1-29 08:41
此函数是“高效率的文本型自动编号函数”，请问，数字型的不行？

这里的函数只支持文本型的编号，不支持数字型，其实数字型的更好处理，另外一般来说如果是数字型的话，直接用“自动编号”数据类型的字段就行了，没什么必要再去自己写代码处理。

红尘如烟

andymark 发表于 2011-1-28 22:57
一直都这样处理

andymark说的不错，这个处理方法其实不是什么新鲜的东西，很多管理软件中都是这样处理的，只不过基本上都是基于SQL Server等数据库的，在Access中的应用，至少我在网上没看到过，所以做了这个示例给大家参考一下。

ycxchen

此函数是“高效率的文本型自动编号函数”，请问，数字型的不行？

ycxchen

下载学习，谢谢分享！

andymark

一直都这样处理