Office: Datensätze in x- und y-Richtung finden

Moinsens, allerseits!

Ich bräuchte mal Hilfe in einer Abfragen-Geschichte, die ich z.Z. gerade per VBA und Temp-Tabellen zu lösen versuche. Aber vielleicht geht es auch direkt per SQL...

Folgende (stark verkürzte) Situation: Es gibt eine Tabelle mit ca. 141.000 Datensätzen. Jeder Datensatz hat u.a. die Felder "Sachnummer", und "Zeichnungsnummer" - klingt numerisch, ist es aber nicht ;-), sind Textfelder. Die Sachnummer (Snr) ist dabei eine eindeutige Bezeichnung, die Zeichnungsnummer (Znr) kann mehrfach bei verschiedenen Sachnummern auftauchen.

Dazu gibt es, und das ist der Casus Cnacktus, noch die Felder "Vorgänger" und "Nachfolger". In diesen Feldern können, müssen aber nicht, Snr stehen, die entsprechend der Vorgänger oder Nachfolger der aktuellen Snr sind. Hierüber ist also eine sogenannte "doppelt verkettete Liste" aufgebaut. Soll heißen:

Snr 123 wurde von Lieferant A bezogen. Durch Lieferanten-Wechsel gibt es eine neue Snr 234 von Lieferant B. Bestellt ein Kunde jetzt Snr A, kann er, wenn dort kein Bestand mehr im Lager ist, automatisch Snr B bekommen. Aber auch Snr B könnte wiederum von Snr C abgelöst worden sein. In Snr A steht als Nachfolger also Snr B. In Snr B steht als Vorgänger Snr A und als Nachfolger Snr C. In Snr C steht als Vorgänger Snr B.

Das ist aber alles nur die eine Hälfte des Problems... ;-)

Jede Snr hat, wie gesagt, ja auch noch eine Znr. Und über die Znr kann es weitere Snr geben, die ebenfalls technisch der ursprünglichen Snr entsprechen, sich nur in Details unterscheiden.

Aufgabe jetzt ist es:

a) Finde alle Snr, die die gleiche Znr wie die aktuell betrachtete Snr haben. Das ist einfach:

Code:

SELECT snr FROM tbl_artikel WHERE znr = '" & me![znr] & "'"

b) Finde alle Vorgänger und Nachfolger der aktuell betrachteten Snr. Das ist schon haariger und ich habe das soweit jetzt mit VBA und 2 Hilfstabellen, die 1:n verknüpft sind, hinbekommen. Das Problem ist ja, daß es beliebig viele Vorgänger bzw. Nachfolger geben kann. Und wenn, was eigentlich nicht sein soll, der Kram "im Kreis" läuft, läuft auch meine VBA-Routine in einer Endlos-Schleife. (Wenn z.B. im obigen Beispiel Snr C wiederum als Nachfolger Snr A hat, dann...)

c) Und jetzt kommt's ganz dick: Finde neben a) auch alle Snr, die die gleiche Znr wie die Vorgänger und Nachfolger haben. Das ist das entscheidende Endprodukt, was benötigt wird.

Sinn der Aktion: Der Kunde kann eine Snr bestellen, die laut seinen Unterlagen vielleicht noch aktuell ist. Wir haben diese aber bereits durch eine andere Snr ersetzt. Oder aber die Snr hat gar keinen Bestand, aber es gibt vielleicht noch Vorgänger, die Bestand haben und alternativ ausgeliefert werden könnten. Oder eine Nachfolge-Variante (über Feld "Nachfolger") hat ein "Gleichteil" (über Feld "Zeichnungsnummer"), das Bestand hat.

Ich muß also einen Bereich von Datensätzen, der sich über x- (Vorgänger, Nachfolger) und y-Richtung (Zeichnungsnummer) erstreckt, in eine einzelne Liste übertragen, damit ein Techniker entscheiden kann, welche alternative Snr benutzt werden kann.

Kriegt man sowas überhaupt noch mit einigermaßem überschaubarem SQL hin? Oder bin ich da mit VBA und Temp-Tabellen doch eher auf dem richtigen Weg?

Gruß, Michael

 

Hallo Michael,

Ich würde es mit einer (Temp-)Tabelle lösen.
1) Als Vorbereitungsschritt:
Diese anlegen mit allen nötigen Feldern; ferner würde ich in dieser das SNr-Feld zu einem eindeutigen Schlüsselfeld machen.

Bei jeder Abfrage die Schritte 2)-6) ausführen:
2) Als ersten Schritt die Sätze der (Temp-)Tabelle löschen; das geht auch mit SQL+VBA ganz gut (CurrentDb.Execute "DELETE * FROM TempTab;")
3) Den Satz mit der aktuellen Snr einfügen
4) Mit einer Do...Loop-Schleife alle Snr-Sätze suchen und anfügen, die zur jeweiligen NfSnr passen, solange bis das lfd. NfSnr-Feld leer ist oder aber eine Schlüsselverletzung im SNr-Feld beim Satzanfügen auftreten würde (zirkuläre NfSnr)
5) Mit einer Do...Loop-Schleife alle Snr-Sätze suchen und anfügen, die zur jeweiligen VorSnr passen, solange bis das lfd. VorSnr-Feld leer ist oder aber eine Schlüsselverletzung im Snr-Feld beim Satzanfügen auftreten würde (zirkuläre VorSnr).
6) Mit einer Anfügeabfrage die passenden Znr-Sätze anfügen. Sätze, bei denen es zu einer Schlüsselverletzung käme, jeweils nicht anfügen.

 

Mein erster Gedanke scheint in der Tat auch der beste gewesen zu sein. Nach etlichen (Fehl-) Versuchen bin ich soweit, eine stabile Routine mit Temp-Tabelle zu haben. Das Kernstück besteht aus:

Code:

Private Sub Ersetzt_Kette_Vorbereitung()

    Dim s As String

    DoCmd.OpenForm "frm_warten_liste": DoEvents

    Set db = CurrentDb
    Set rs = db.OpenRecordset(rs_name, dbOpenSnapshot): DoEvents
    rs.MoveFirst

    'Liste "n" (1:n abhängig von Liste "1") leeren
    s = "DELETE * FROM " & tkette2
    db.Execute s: DoEvents

    'Liste "1" leeren
    s = "DELETE * FROM " & tkette1
    db.Execute s: DoEvents

End Sub

Private Sub Ersetzt_Kette(snr$)

    Dim snrmrk As String
    Dim snr1st As String
    Dim rs_act As String
    Dim rs_part As String
    Dim rs_drawing As String
    Dim rs_partorder As Long
    Dim rs_partref As String
    Dim rs_class As String
    Dim rs_sbe As String
    Dim rs_stock As Double
    Dim rs_key As String
    Dim rs_newpart As String
    Dim rs_vb As String
    Dim rs_oldpart As String
    Dim s As String
    Dim prvnxt As Long
    Dim nextpart As String
    Dim nextpartfield As String

    snrmrk = rs.Bookmark

    rs.FindFirst "[PART NUMBER] = '" & snr & "'"
    If (Not rs.NoMatch) Then

        'Lesezeichen merken
        snr1st = rs.Bookmark

        rs_act = Trim$(rs("[act]") & " ")
        rs_part = Trim$(rs("[part number]") & " ")
        rs_drawing = Trim$(rs("[drawing number]") & " ")
        rs_partorder = 0
        rs_partref = rs_part
        rs_class = Trim$(rs("[class soc]") & " ")
        rs_sbe = Trim$(rs("[type sbe]") & " ")
        rs_stock = 0: On Error Resume Next: rs_stock = rs("[material on hand]"): On Error GoTo 0
        rs_key = Trim$(rs("[sperrschluessel]") & " ")
        rs_newpart = Trim$(rs("[replaced by]") & " ")
        rs_vb = Trim$(rs("[vb]") & " ")
        rs_oldpart = Trim$(rs("[old part no]") & " ")

        'Snr in Liste "1" aufnehmen
        s = "INSERT INTO " & _
                tkette1 & " " & _
            "VALUES ( " & _
                "'" & rs_part & "' )"
        db.Execute s: DoEvents
        '...und auch in Liste "n" aufnehmen
        s = "INSERT INTO " & _
                tkette2 & " " & _
            "VALUES ( " & _
                "'" & rs_act & "', " & _
                "'" & rs_part & "', " & _
                "'" & rs_drawing & "', " & _
                rs_partorder & ", " & _
                "'" & rs_partref & "', " & _
                "'" & rs_class & "', " & _
                "'" & rs_sbe & "', " & _
                rs_stock & ", " & _
                "'" & rs_key & "', " & _
                "'" & rs_newpart & "', " & _
                "'" & rs_vb & "', " & _
                "'" & rs_oldpart & "' )"
        db.Execute s: DoEvents
        'Gleichteile laut Zeichnungsnummer in Liste "n" aufnehmen, wenn znr gueltiges Format hat
        If (Znr_ueberpruefen(rs_drawing)) Then
            s = "INSERT INTO " & _
                    tkette2 & " " & _
                "SELECT " & _
                    tkomplett & ".[act] AS [act], " & _
                    tkomplett & ".[part number] AS [part number], " & _
                    tkomplett & ".[drawing number] AS [drawing number], " & _
                    rs_partorder & " AS [part number order], '" & _
                    rs_partref & "' as [part number ref], " & _
                    tkomplett & ".[class soc] AS [class soc], " & _
                    tkomplett & ".[type sbe] AS [type sbe], " & _
                    tkomplett & ".[material on hand] AS [material on hand], " & _
                    tkomplett & ".[sperrschluessel] AS [sperrschluessel], " & _
                    tkomplett & ".[replaced by] AS [replaced by], " & _
                    tkomplett & ".[vb] AS [vb], " & _
                    tkomplett & ".[old part no] AS [old part no] " & _
                "FROM " & _
                    tkomplett & " " & _
                "WHERE " & _
                    "(" & tkomplett & ".[part number]<>'" & rs_part & "') AND " & _
                    "(" & tkomplett & ".[drawing number]='" & rs_drawing & "')"
            db.Execute s: DoEvents
        End If

        For prvnxt = 1 To 2
            rs.Bookmark = snr1st
            rs_partorder = 0
            Select Case prvnxt
                Case 1
                    nextpartfield = "[OLD PART NO]"
                Case 2
                    nextpartfield = "[REPLACED BY]"
            End Select
            nextpart = rs(nextpartfield) & ""
            'hat die Snr einen Vorgänger / Nachfolger?
            While (nextpart <And>= "100000000") And (nextpart <= "999999999")
                'ja: Snr suchen
                rs.FindFirst "[PART NUMBER] = '" & nextpart & "'"
                If (Not rs.NoMatch) Then

                    'in Liste "n" aufnehmen
                    rs_act = Trim$(rs("[act]") & " ")
                    rs_part = Trim$(rs("[part number]") & " ")
                    rs_drawing = Trim$(rs("[drawing number]") & " ")
                    rs_partorder = rs_partorder - 1
                    'rs_partref = snract
                    rs_class = Trim$(rs("[class soc]") & " ")
                    rs_sbe = Trim$(rs("[type sbe]") & " ")
                    rs_stock = 0: On Error Resume Next: rs_stock = rs("[material on hand]"): On Error GoTo 0
                    rs_key = Trim$(rs("[sperrschluessel]") & " ")
                    rs_newpart = Trim$(rs("[replaced by]") & " ")
                    rs_vb = Trim$(rs("[vb]") & " ")
                    rs_oldpart = Trim$(rs("[old part no]") & " ")

                    s = "INSERT INTO " & _
                            tkette2 & " " & _
                        "VALUES ( " & _
                            "'" & rs_act & "', " & _
                            "'" & rs_part & "', " & _
                            "'" & rs_drawing & "', " & _
                            rs_partorder & ", " & _
                            "'" & rs_partref & "', " & _
                            "'" & rs_class & "', " & _
                            "'" & rs_sbe & "', " & _
                            rs_stock & ", " & _
                            "'" & rs_key & "', " & _
                            "'" & rs_newpart & "', " & _
                            "'" & rs_vb & "', " & _
                            "'" & rs_oldpart & "' )"
                    db.Execute s: DoEvents
                    'Gleichteile laut Zeichnungsnummer in Liste "n" aufnehmen, wenn znr gueltiges Format hat
                    If (Znr_ueberpruefen(rs_drawing)) Then
                        s = "INSERT INTO " & _
                                tkette2 & " " & _
                            "SELECT " & _
                                tkomplett & ".[act] AS [act], " & _
                                tkomplett & ".[part number] AS [part number], " & _
                                tkomplett & ".[drawing number] AS [drawing number], " & _
                                rs_partorder & " AS [part number order], '" & _
                                rs_partref & "' as [part number ref], " & _
                                tkomplett & ".[class soc] AS [class soc], " & _
                                tkomplett & ".[type sbe] AS [type sbe], " & _
                                tkomplett & ".[material on hand] AS [material on hand], " & _
                                tkomplett & ".[sperrschluessel] AS [sperrschluessel], " & _
                                tkomplett & ".[replaced by] AS [replaced by], " & _
                                tkomplett & ".[vb] AS [vb], " & _
                                tkomplett & ".[old part no] AS [old part no] " & _
                            "FROM " & _
                                tkomplett & " " & _
                            "WHERE " & _
                                "(" & tkomplett & ".[part number]<>'" & rs_part & "') AND " & _
                                "(" & tkomplett & ".[drawing number]='" & rs_drawing & "')"
                        db.Execute s: DoEvents
                    End If
                    nextpart = rs(nextpartfield) & ""
                  Else
                    nextpart = ""
                End If
            'wiederholen
            Wend
        Next prvnxt

        'wurden Vorgänger / Nachfolger gefunden?
        'nein: aus Liste "1" löschen
        's = "DELETE * FROM " & tkette1 & " WHERE [PART NUMBER] = '" & snract & "'"
        'db.execute s,:doevents

        'auf gemerktes Lesezeichen zurück
        rs.Bookmark = snrmrk

    End If

End Sub

Private Sub Ersetzt_Kette_Abschluss()

    Dim s As String

    s = "UPDATE " & tkette2 & " SET [material on hand]=0 WHERE ([material on hand]<1);"
    db.Execute s: DoEvents

    Set rs = Nothing
    Set db = Nothing

    DoCmd.Close acForm, "frm_warten_liste", acSaveNo: DoEvents

End Sub

Das etwas Unschöne an der Sache ist, daß das Mistding recht lange braucht. Es sind, wie gesagt, ca. 141.000 Datensätze, die durchgeackert werden müssen. Das Kern-Problem scheint an 2 Stellen zu liegen:
a) Das Öffnen des Recordset dauert schon einiges an Zeit.
b) Die Anfüge-Query, in der alle Snr mit gleicher Znr angefügt werden, dauert ebenfalls recht lange.
Bei a) habe ich schon mit DynaSet und SnapShot experimentiert, aber eklatante Unterschiede konnte ich nicht feststellen. Und für die Optimierung der Anfüge-Query fehlt mir auch eine Idee. Indizes sollten eigentlich auf allen relevanten Feldern gesetzt sein.

Jemand noch eine Idee, wie man das Ding beschleunigen kann? So ist es fast nicht nutzbar (minutenlanges Warten), was sehr schade wäre, weil es einigen Kollegen wirklich sehr viel helfen würde.

Gruß, Michael

 

O M G

Ich muß wohl die ganze Zeit blind gewesen sein. Dabei hatte ich die eigentliche Lösung sogar schon im Zuge der ganzen Versuche in der Hand gehabt, aber wieder verworfen!

Der haupsächliche Bottleneck war ja

Code:

Set rs = db.OpenRecordset(rs_name, dbOpenSnapshot)

Ich brauchte nur die Datenquelle des Formulars, aus dem heraus per Button die Ersetzt-Kette zusammengesucht werden soll, etwas anpassen und konnte im Source dann obige Zeile in

Code:

Set rs = Forms("frm_Sachnummerninformationen").RecordsetClone

ändern. Und schwupps... ist mindestens 2/3 der Rechenzeit eingespart, eher noch mehr.

Gut, daß wir mal drüber geredet haben... ;-)

Ich geh jetzt auch erstmal in die Ecke und schäme mich...

Gruß, Michael