Код:
Option Compare Database
Option Explicit
Public Function IsTable(NameTable As String) As Boolean
Dim i As Integer
IsTable = False
For i = 0 To CurrentDb.TableDefs.Count - 1
If CurrentDb.TableDefs(i).Name = NameTable Then IsTable = True
Next i
End Function
Sub cmth()
Dim db As Database
Dim rs As Recordset
Dim lngRecordCount As Long, lngFirstN As Long, lngCurrN As Long
Dim txtRecordCount As String, txtFirstN As String, txtCurrN As String, txtNPrev As String
Dim lngNPrev As Long, Count As Long
Dim txtSql As String
Set db = CurrentDb
Set rs = db.OpenRecordset("q2", dbOpenDynaset)
If rs.RecordCount <> 0 Then
If IsTable("tblResult") Then
DoCmd.SetWarnings False
DoCmd.RunSQL ("DELETE * FROM [tblResult]")
DoCmd.SetWarnings True
Else
DoCmd.RunSQL ("CREATE TABLE tblResult ([First N] LONG,[Last N] LONG, [FirstT] TEXT(10), [LastT] TEXT(10), Count LONG)")
End If
rs.MoveLast
lngRecordCount = rs.RecordCount
rs.MoveFirst
lngFirstN = rs![NR]: txtFirstN = rs![Document N]
rs.MoveNext
lngNPrev = lngFirstN: txtNPrev = txtFirstN
Count = 1
Do Until rs.EOF
lngCurrN = rs![NR]: txtCurrN = rs![Document N]
If lngCurrN - lngNPrev = 1 Then
Count = Count + 1
Else
Debug.Print lngFirstN & " " & lngNPrev & " " & Count
txtSql = "INSERT INTO [tblResult] " _
& "([First N],[Last N],[FirstT],[LastT], Count) VALUES " _
& "(" & lngFirstN & "," & lngNPrev & ", '" & txtFirstN & "', '" & txtNPrev & "', " & Count & ");"
DoCmd.SetWarnings False
DoCmd.RunSQL (txtSql)
DoCmd.SetWarnings True
Count = 1
lngFirstN = lngCurrN: txtFirstN = txtCurrN
End If
lngNPrev = lngCurrN: txtNPrev = txtCurrN
rs.MoveNext
Loop
Else
MsgBox "NO DATA"
End If
Debug.Print lngFirstN & " " & lngNPrev & " " & Count
txtSql = "INSERT INTO [tblResult] " _
& "([First N],[Last N],[FirstT],[LastT], Count) VALUES " _
& "(" & lngFirstN & "," & lngNPrev & ", '" & txtFirstN & "', '" & txtNPrev & "', " & Count & ");"
DoCmd.SetWarnings False
DoCmd.RunSQL (txtSql)
DoCmd.SetWarnings True
End Sub