Warsztat: Wypełnianie dziur w polu Autonumer.

AutoNr.zip
Autor: Krzysztof Pozorek
Baza w formacie MsAccess 97

Opis problemu:

Dziury w polu Autonumer powstają na skutek kasowania rekordów lub zaniechania wprowadzenia rekordu. Zdarza się, że dziury w numeracji są niepożądane.

Rozwiązanie:

Prezentowany przykład pokazuje sposób zapisywania nowych rekordów bez dziur. Przykład testowano na zestawie rekordów ok. 60 tys. rekordów. Uzyskane wyniki czasowe wynoszą ok. 1,8 sek. na dodanie nowego rekordu. 

Rewelacyjne wyniki rzędu kilkudziesięciu milisekund(!) uzyskał Krzysztof Naworyta, którego rozwiązanie cytuję poniżej (rozwiązanie Krzysztofa polega na bardzo szybkim zawężaniu zestawu rekordów do przeszukania)
Poniżej zamieszczam rozwiązanie Krzysztofa (wersja uaktualniona):

Zamiast recordset typu dbOpenDynaset - dbOpenTable. To powoduje, że nie mogę korzystać z AbsolutePosition (co zresztą okazuje się zupełnie zbędne) Cała trudność (???) - a raczej opóźnienie wykonania - to właściwe posortowanie zestawu rekordów, które dokonuje się przez ustawienie właściwości recordset.Index (pozwala to na szukanie dziur w dowolnym polu unikalnym ! - nie tylko kluczu!) Na zestawie 1 miliona rekordów nie sprawdziła się teza, że tabela otwiera się samoistnie wg porządku klucza głównego (!!!) Być może jest to kwestia RAM'u czy bo-ja-wiem-co. Zwykle nie operuję na takiej ilości danych ;-) Niemniej - w porównaniu z poprzednią postacią funkcji (dbOpenDynaset) i tak widać pewne dodatkowe przyśpieszenie (10-30%) Dla zestawu 1 miliona rekordów czas znalezienia dziury (pomijając dwa przypadki skrajne: dziura w pierwszym lub brak dziury) dokonuje się w 0,7sek. (dla 60tyś wynik wynosi 30-40 milisek !) Jest to czas stabilny - niezależny od położenia dziury. Można się zastanowić czy założenie, że pierwszy element =1 jest konieczne. Wydaje się, że niewielka przeróbka pozwoliłaby szukać jakiejkolwiek nieciągłości w numeracji, począwszy od dowolnej wartości startowej. Warunek: unikalność. Ale coś mi mówi, że tę unikalność też można obejść ... Tylko że jeszcze nie zastanawiałem się co mogłoby być wskaźnikiem znalezienia nieciągłości ... pozdrawiam KN 
Option Compare Database
Option Explicit

Public Declare Function GetTickCount Lib "kernel32" () As Long

Function APITimer() As Long
  APITimer = GetTickCount
End Function

Function FindDziura() As Long
Dim db As Database
Dim rs As Recordset

Dim krok As Long
Dim poz As Long
Dim fd As String
Dim mx As Long, mn As Long

Dim t
t = APITimer()

Set db = CurrentDb
Set rs = db.OpenRecordset("T", dbOpenTable)
' procedura otwiera rekordset na tabeli lokalnej
' w stosunku do bazy db.
' właściwe jej posortowanie wymuszane jest ustawieniem indeksu

With rs
' *** brak rekordów
  If .BOF And .EOF Then
    FindDziura = 1
    Exit Function
  End If

' od tego momentu zaczyna się właściwe szukanie
' można szukać dziur nie tylko w kluczu głównym
' ale w którymkolwiek polu, dla którego ustawiono indeks unikalny
' ustawienie właściwości Index recordsetu typu tabela jest duuużo szybszym
' sposobem właściwego posortowania niż instrukcja "Select ... Order By"

' tu następuje główne opóźnienie - ustawienie porządku
  .Index = "LP"
  fd = "Lp"

' *** dziura na początku zestawu
  If .Fields(fd) <> 1 Then
    FindDziura = 1
    Exit Function
  End If

' *** są rekordy
  .MoveLast
'krok = .RecordCount

  mn = 0 '1
  mx = .RecordCount
  poz = mx

'jeśli nie ma dziur
  If .Fields(fd) = poz Then
    FindDziura = poz + 1
    Exit Function
  End If

' *** jesli znaleziono "przesunięcie", zacieśniaj obszar
 krok = -(mx - mn) / 2

 Do
    .Move krok
    poz = poz + krok
    'Debug.Print .Fields(fd), poz
    If .Fields(fd) <> poz Then
      mx = poz
      'znak = -1, krok w stronę BOF
      krok = -Int((mx - mn) / 2)
    Else
      'znak = +1, krok w stronę EOF
      mn = poz
      krok = Int((mx - mn) / 2)
    End If
 Loop Until mx <= mn + 1

' *** korekta

  If .Fields(fd) = poz Then
    Do Until .Fields(fd) <> poz
      'Debug.Print 1
      .Move 1
      poz = poz + 1
    Loop
    FindDziura = poz
  Else
    Do Until .Fields(fd) = poz
      'Debug.Print -1
      .Move -1
      poz = poz - 1
    Loop
    FindDziura = poz + 1
  End If

  t = APITimer() - t
  Debug.Print "milisek: " & t
End With
rs.Close: Set rs = Nothing
db.Close: Set db = Nothing

End Function

Powyższy przykład wymaga istnienia tabeli o nazwie T i indeksowanego pola Lp (nazwa indeksu, to również Lp).

Krzysztof Pozorek