求解决自动编号，补充断号无法实现.

fnsmydyang

求各位网友老师帮我解决问题.
      我有一张表为订单明细,当日序号为(Key),要求自动编号,编号是由一个字符+年月日+三位流水号(1~999)组成,正常的情况下编号是从小到大编号,现我要求从大到小编号,由于实际操作过程中有断号的现象(删除),为了充分利用资源,希望可以补号之功能,自已写了一段代码,出现一些\问题,求教,谢谢
附件:

代码如下:
Private Sub 模号_BeforeUpdate(Cancel As Integer)
  On Error Resume Next
  Dim maxid As Integer
  Dim K As String
  Dim I As Integer
  Dim C As Double
  Dim rs As DAO.Recordset
  Set rs = CurrentDb.OpenRecordset("SELECT Val(Right([当日序号],3)) AS 序号, Mid([当日序号],2,5) AS 条件 FROM 订单明细 " _
                                   & "WHERE (((Mid([当日序号],2,5))=Mid(Format(Date(),'yymmdd'),2,5))) " _
                                   & "ORDER BY Val(Right([当日序号],3)) DESC")

  If rs.RecordCount <= 0 Then
     K = "B" & Mid(Format(Date, "yymmdd"), 2, 5) & "999"
     Me![当日序号] = K
     Exit Sub
  Else
     maxid = 999
  rs.MoveFirst
  For I = 0 To rs.RecordCount
        MsgBox rs(0)
        If (maxid - I) = rs(0) Then
            rs.MoveNext
        Else
            Me![当日序号] = "B" & Mid(Format(Date, "yymmdd"), 2, 5) & Format(maxid - I, "000")
            Exit For
        End If
  Next
  End If
Set rs = Nothing
End Sub
问题:
当记录为空时,可以,当输入第二笔记录不行,如果第二笔手输入一个断号又可以,可能是循环语句出了问题,但找不出问题点,求赐教.[:45]

Henry D. Sy

记得论坛上有例子，你先找着看

fnsmydyang

6D老师,我找过了,写的是一个函数,没有写完,我还是希望找出自已的问题点,求指点,谢谢
http://www.accessoft.com/article-show.asp?id=1559

fnsmydyang

原帖由 Henry D. Sy 于 2009-1-14 22:29 发表
记得论坛上有例子，你先找着看

在我们的坛论上找到了http://www.office-cn.net/forum.php?mod=viewthread&tid=60878&highlight=%B2%B9%BA%C5
可我自己的代码问题还是没有解决,[:42] 求赐教,先谢谢了...

layaman_999

补充断号没有什么意义，何必这么浪费系统资源去处理这种问题，设计数据库最重要的是性能。
断号如果是中间缺失，要补充它，只有使用记录集循环判断，或者另建立一个表记录被删除的断号，期待后续使用。
其实断号也是一种资源，可以判断在单据中有几个单据曾经被删除过。
为防止资源短缺，建议为编码增加一位数，以获得足够的编码空间。

fnsmydyang

所长说的对,只是在设计数据库时,没有考虑全面,,所以只能在程序上补充一些功能,目前碰到了一些问题,要求解决,还望网友老师检查我的代码,,错在哪里?不胜感激,[:45]

Henry D. Sy

原帖由 fnsmydyang 于 2009-1-14 22:39 发表
6D老师,我找过了,写的是一个函数,没有写完,我还是希望找出自已的问题点,求指点,谢谢
http://www.accessoft.com/article-show.asp?id=1559

这是论坛上管理员，andymark老大的作品，您可以给他短消息。

Trynew

程序中没处理有号码但没断号这种情况，还有就是记录的循环多了一次。
看看这样改行不行：
    If (maxid - I) = rs(0) and i<rs.RecordCount  Then
            rs.MoveNext
        Else
    .......

fnsmydyang

谢谢Trynew老师和6D老师的回复,[:24]
按照Trynew老师修改后,还是不行,真是搞不明白,不知道谁能帮我解决这个问题呢?

fnsmydyang

谢谢CUXUN老大,
我这样修改也行,只是不明白其所以.
On Error Resume Next
  Dim maxid As Integer
  Dim K As String
  Dim I As Integer
  Dim C As Double
  Dim rs As DAO.Recordset
  Set rs = CurrentDb.OpenRecordset("SELECT Val(Right([当日序号],3)) AS 序号, Mid([当日序号],2,5) AS 条件 FROM 订单明细 " _
                                   & "WHERE (((Mid([当日序号],2,5))=Mid(Format(Date(),'yymmdd'),2,5))) " _
                                   & "ORDER BY Val(Right([当日序号],3)) DESC")

  If rs.RecordCount <= 0 Then
     K = "B" & Mid(Format(Date, "yymmdd"), 2, 5) & "999"
     Me![当日序号] = K
     Exit Sub
      rs.Close
  Else
     maxid = 999
  rs.MoveFirst
  For I = 0 To rs.RecordCount
        MsgBox rs(0)
        If (maxid - I) <> rs(0) Then
             Me![当日序号] = "B" & Mid(Format(Date, "yymmdd"), 2, 5) & Format(maxid - I, "000")
            Exit For
        Else
           rs.MoveNext
        End If
  Next
  End If
  Set rs = Nothing