Neuigkeiten:

Wenn ihr euch für eine gute Antwort bedanken möchtet, im entsprechenden Posting einfach den Knopf "sag Danke" drücken!

Mobiles Hauptmenü

Fehler beim transponieren

Begonnen von Aloster, Januar 16, 2012, 13:59:01

⏪ vorheriges - nächstes ⏩

Aloster

Access 2007

Hallo,

ich habe eine Abfrage "Portoverbrauch" mit den Spaltenüberschriften:
Anzahl 0,45; Anzahl 0,49; Anzahl 0,55; Anzahl 0,75; Anzahl 0,86; Anzahl 0,90; Anzahl 1,31; Anzahl 1,45
und den folgenden dazugehören Feldwerten
                1;              27;           31;                 2;               0;                    0;              24;              32;

Die Abfrage transponiere ich in die Tabelle "Portoverbrauch transponiert" mit den Spaltenüberschriften 1 und 2:

                1     2
Anzahl 0,45   1
Anzahl 0,49   26
Anzahl 0,55   31
Anzahl 0,75   2
Anzahl 0,86   0
Anzahl 0,90   0
Anzahl 1,31   24
Anzahl 1,45   32

Das Problem ist, dass der Wert von "Anzahl 0,49" nicht richtig transponiert wird. Statt, dass in die Tabelle die 27 geschrieben wird, erscheint nur eine 26. Das Muss wohl an der Funktion/Modul liegen. Wo liegt der Fehler?

Hier die Funktion:

Function TransposeTable(strSourceObj As String, _
                        strTranspTable As String) As Boolean
    Dim db As DAO.Database
    Dim rsBasis As DAO.Recordset
    Dim rsTranspose As DAO.Recordset
    Dim tdfNewDef As DAO.TableDef
    Dim fldNewField As DAO.Field
    Dim I As Integer, J As Integer
    Dim intNumRecs As Integer
    Dim intNumFields As Integer

    TransposeTable = False 'Default-Rueckmeldung
    'Recordset für Basis-Tabelle initialisieren
    Set db = CurrentDb()
    Set rsBasis = db.OpenRecordset(strSourceObj)
    rsBasis.MoveLast
    '1. Spalte für Feldnamen
    intNumRecs = rsBasis.RecordCount
    If intNumRecs > 254 Then
        Beep
        MsgBox "Tabelle " & strSourceObj & " beinhaltet mehr als 254 " & _
               "Datensaetze...", vbOKOnly + vbExclamation, "!!! Problem !!!"
        rsBasis.Close
        Exit Function
    End If
    intNumFields = rsBasis.Fields.Count - 1
    For I = 0 To intNumFields
        If rsBasis.Fields(I).Type = dbMemo Or _
           rsBasis.Fields(I).Type = dbLongBinary Then
            Beep
            MsgBox "Tabelle " & strSourceObj & " beinhaltet spezielle " & _
                   "Felder, " & "die nicht komplett übernommen werden " & _
                   "können...", vbOKOnly + vbInformation, "!!! Hinweis !!!"
        End If
    Next I
    'Ziel-Tabelle anlegen/loeschen...
    DoCmd.Hourglass True
    DoEvents
    On Error Resume Next
    Set tdfNewDef = db.TableDefs(strTranspTable)
    If Err = 0 Then 'Tabelle ist vorhanden, loeschen
        DoCmd.SetWarnings False
        DoCmd.DeleteObject acTable, strTranspTable
        DoCmd.SetWarnings True
    End If
    Set tdfNewDef = db.CreateTableDef(strTranspTable)
    For I = 0 To rsBasis.RecordCount
        Set fldNewField = tdfNewDef.CreateField(CStr(I + 1), dbText)
        tdfNewDef.Fields.Append fldNewField
    Next I
    Err = 0
    db.TableDefs.Append tdfNewDef
    If Err <> 0 Then
        DoCmd.Hourglass False
        Beep
        MsgBox "Tabelle " & strTranspTable & " konnte nicht angelegt " & _
               "werden..." & vbCrLf & vbCrLf & "Fehler: " & _
               CStr(Err.Number) & "/" & Err.Description, _
               vbOKOnly + vbExclamation, "!!! Probblem !!!"
        rsBasis.Close
        Exit Function
    End If
    'Recordset für Ziel-Tabelle initialisieren
    '1. Spalte mit Feldnamen fuellen
    Set rsTranspose = db.OpenRecordset(strTranspTable)
    For I = 0 To rsBasis.Fields.Count - 1
        With rsTranspose
            .AddNew
            .Fields(0) = rsBasis.Fields(I).Name
            .Update
        End With
    Next I
    'ab 2. Spalte mit Daten fuellen
    rsBasis.MoveFirst
    rsTranspose.MoveFirst
    For J = 0 To rsBasis.Fields.Count - 1
        For I = 1 To rsTranspose.Fields.Count - 1
            With rsTranspose
                .Edit
                .Fields(I) = rsBasis.Fields(J)
                rsBasis.MoveNext
                .Update
            End With
        Next I
        rsBasis.MoveFirst
        rsTranspose.MoveNext
    Next J
    'und fertig...
    TransposeTable = True
    rsBasis.Close
    rsTranspose.Close
    DoCmd.Hourglass False
End Function




Aloster

Habe Fehler gefunden. Hatte was mit der Aktualisierung der Daten zu tun.