VBA Tipp: Freie Nummern belegen

Aus DBWiki
Wechseln zu: Navigation, Suche

Vorbemerkung

Man sollte sich sehr überlegen, ob es wirklich notwendig ist, Nummern fortlaufend zu vergeben. Optische/ästhetische Überlegungen ("Angst vor der Lücke") oder Überlegungen zum Zahlenraum ("Angst, dass der Index überläuft") sollten keine Rolle spielen, da sie in aller Regel gegenstandslos sind.

Bei der Erstellung von Rechnungsnummern ist die Vergabe von fortlaufenden Rechnungsnummern zwar gesetzlich vorgeschrieben, jedoch ist in dem Fall zu bedenken, dass eine mehrmalige Verwendung von Rechnungsnummern (z.B. weil eine Rechnung storniert wurde) nicht gesetzeskonform ist und zu Problemen mit der Steuerbehörde führen wird.

Auf jeden Fall sollte bedacht werden, dass durch die Wiederbelegung von Nummern leicht Artefakte entstehen. (Z.B., wenn ein Papierdokument mit der "alten Nummer" erstellt wurde, die Nummer später erneut vergeben wurde und sich dann später auf das alte Dokument bezogen wird). Wird der Schlüssel als Fremdschlüssel verwendet, so müssen auch jeweils alle Fremdschlüsselfelder nachgezogen werden - ein meist unnötiger Aufwand und eine zusätzliche Fehlerquelle.

Wiki hinweis.png Anmerkung: Handelt es sich bei den Nummern um Belegnummern ist auf das Auffüllen von Lücken grundsätzlich zu verzichten!


Eigentlich kann es nur externe Gründe geben, Nummern wieder zu belegen, z.B., weil damit ein endlicher Pool von externen Entitäten mit fester Nummerierung verbunden ist.

Aufgabenstellung

Ich möchte freie Nummern in einem Feld der Reihe nach wieder belegen.

Lösung 1

Die folgende Funktion ermittelt die erste freie Nummer in einer aufsteigenden Folge von ganzzahligen Feldern:

Public Function FreieNummer(FeldName, TabName)
Dim DB As Database, RS As DAO.Recordset, I As Long, SQL As String
  Set DB = CurrentDb
  SQL = "SELECT [" & FeldName & "] FROM [" & TabName & "] " & _
        "ORDER BY Val(Nz([" & FeldName & "],0))"
  Set RS = DB.OpenRecordset(SQL, dbOpenSnapshot)
  I = 1
  Do While Not RS.EOF
    If I <> Val(Nz(RS(0), 0)) Then Exit Do
    I = I + 1
    RS.MoveNext
  Loop
  FreieNummer = I
  RS.Close
  Set RS = Nothing
  DB.Close
End Function

Aufruf

Me!ID = FreieNummer("ID","MeineTabelle")

Lösung 2

Die folgende Funktion ermittelt die erste freie Nummer in einer aufsteigenden Folge von ganzzahligen Feldern, wobei

  • sie auch bei mehrfachen Einträgen die richtige Zahl liefert,
  • die Funktion performanter ist (spürbar erst bei vielen Zahlen (>10000)) und
  • ein Startwert übergeben werden kann:
Public Function GetFreieNummer(sTheField As String, sTheTable As String, _
                               Optional lStart As Long = 1) As Long
Dim sSQL As String
 
'Gibt's in der Tabelle den Startwert?
GetFreieNummer = lStart
 
sSQL = "SELECT  [" & sTheField & "]     " _
    & " FROM    [" & sTheTable & "]     " _
    & " WHERE   [" & sTheField & "] = " & lStart
 
'Wenn nicht, dann sind wir fertig
If DBEngine(0)(0).OpenRecordset(sSQL).EOF Then Exit Function
 
 
'diese Abfrage gibt alle Datensätze zurück, _
 für deren ID kein Datensatz mit ID + 1 existiert.
 
sSQL = "SELECT  SQ.FreeID                                " _
    & " FROM    (SELECT TheTable.TheField + 1 AS FreeID  " _
    & "          FROM   TheTable                         " _
    & "         ) AS SQ                                  " _
    & " LEFT JOIN   TheTable                             " _
    & " ON      SQ.FreeID = TheTable.TheField            " _
    & " WHERE   TheTable.TheField Is Null                " _
    & " AND     SQ.FreeID > " & lStart _
    & " ORDER BY    SQ.FreeID                            "
 
sSQL = Replace(sSQL, "TheTable", "[" & sTheTable & "]")
sSQL = Replace(sSQL, "TheField", "[" & sTheField & "]")
 
GetFreieNummer = DBEngine(0)(0).OpenRecordset(sSQL).Fields(0)
 
End Function

Aufruf

Me!ID = GetFreieNummer("ID","MeineTabelle")