Question

我有这个功能，它尝试自动排序从数字8000开始的数字，并且数字种子每天回到8000。该功能还尝试确保没有间隙，因此如果存在手动输入并且该数字创建间隙，则该字段将不会从手动输入中排序。但我似乎无法让代码工作，因为它只是保持与前一个条目相同的数字，并没有增加。

Public Function fRetNextInSequence() As Long
 Dim MyDB As DAO.Database
 Dim rst As DAO.Recordset
 Dim rstClone As DAO.Recordset

 'If there are no Records in tblData, then have the Function return 8000
 If DCount("strSerialNumber", "tblOrderData", "dtmDateOrdered=#" & Date & "#") = 0 Then
   fRetNextInSequence = 8000
     Exit Function
End If

 Set MyDB = CurrentDb
 Set rst = MyDB.OpenRecordset("tblOrderData", dbOpenSnapshot)
 Set rstClone = rst.Clone

 rst.MoveLast        'Move to Last Record [MyNum]
 With rstClone       'Move to Next-to-Last Record [MyNum]
   .MoveLast
   .Move -1          'Clone now at Next-to-Last Record [MyNum]
 End With

 With rst
   Do While Not rstClone.BOF
     If Abs(![strSerialNumber] - rstClone![strSerialNumber]) > 1 Then
       fRetNextInSequence = (rstClone![strSerialNumber] + 1)       'Found the Gap!
         Exit Function
     End If
       .MovePrevious             'Move in sync, 1 Record apart
       rstClone.MovePrevious
   Loop
 End With

 rst.MoveLast

 fRetNextInSequence = (rst![strSerialNumber] + 1)       'No Gap found, return next number in sequence!

 rstClone.Close
 rst.Close
 Set rstClone = Nothing
 Set rst = Nothing
 End Function       

    If SOS = "ES-S" Then
        SerialNbrValue = fRetNextInSequence
        'SerialNbrValue = Val(Nz(DMax("strSerialNumber", "tblOrderData", "dtmDateOrdered=#" & Date & "#"), 7999)) + 1
    Else
        SerialNbrValue = ""
    End If

Answer 1

退出循环中的函数会绕过要关闭的行并清除记录集对象。这不是导致问题的原因，但是如果每次打开记录集时都没有使用它们，为什么要使用它们呢？

以下修订过程让我在从VBA立即窗口调用函数时返回适当的顺序：

Public Function fRetNextInSequence() As Long
Dim MyDB As DAO.Database
Dim rst As DAO.Recordset
Dim rstClone As DAO.Recordset

If Nz(DMin("strSerialNumber", "tblOrderData", "dtmDateOrdered=Date()"), 0) <> 8000 Then
    'If there are no Records or the gap is 8000 for current date, Function returns 8000
    fRetNextInSequence = 8000
Else
    Set MyDB = CurrentDb
    Set rst = MyDB.OpenRecordset("SELECT strSerialNumber FROM tblOrderData WHERE dtmDateOrdered=Date() ORDER BY strSerialNumber", dbOpenSnapshot)
    Set rstClone = rst.Clone

    rst.MoveLast        'Move to Last Record [MyNum]
    With rstClone       'Move to Next-to-Last Record [MyNum]
      .MoveLast
      .Move -1          'Clone now at Next-to-Last Record [MyNum]
    End With

    With rst
    Do While Not rstClone.BOF
        If Abs(![strSerialNumber] - rstClone![strSerialNumber]) > 1 Then
            'Found the Gap!
            fRetNextInSequence = (rstClone![strSerialNumber] + 1)
            Exit Do
        End If
        .MovePrevious             'Move in sync, 1 Record apart
        rstClone.MovePrevious
    Loop
    End With

    If fRetNextInSequence = 0 Then
        'No Gap found, return next number in sequence!
        rst.MoveLast
        fRetNextInSequence = (rst![strSerialNumber] + 1)       
    End If
    rstClone.Close
    rst.Close
    Set rstClone = Nothing
    Set rst = Nothing
End If
End Function

DMax数字序列修复差距

1 个答案: