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
Habe Fehler gefunden. Hatte was mit der Aktualisierung der Daten zu tun.