Kreuztabelle auflösen

[Alexander Konopka]

Hallo,

ich möchte eine vorgegebene (Kreuz)Tabelle der Form

Jan Feb Mär
Prod1 A B C
Prod2 D E F
Prod3 G G I

unter Access umwandeln in

Jan Prod1 A
Jan Prod2 D
Jan Prod3 G
Feb Prod1 B
...

Trotz längeren suchens habe ich bisher nicht rausgefunden wie ich dies
bewerkstelligen soll.
Für Hilfe (Lösungsansatz/Sichwort reicht) wäre ich sehr dankbar.
Vielen Dank

Gruß,
Alexander Konopka

[Anette Becker]

Moin Alexander,

>ich möchte eine vorgegebene (Kreuz)Tabelle der Form

>[schnipp]
>unter Access umwandeln in
>[schnapp]

>Trotz längeren suchens habe ich bisher nicht rausgefunden wie ich
dies
>bewerkstelligen soll.

warum nimmst Du dann nicht gleich die Abfrage oder die Tabelle, auf
deren Basis die Kreuztabelle erstellt wurde?

Gruss Anette
--
==> Keine Mails zu NG-Fragen - ist das sooo schwer zu verstehen! <==
http://www.pc-creativ.de
APP: http://www.accessprofipool.de
FAQ: http://www.donkarl.com

[Alexander Konopka]

>warum nimmst Du dann nicht gleich die Abfrage oder die Tabelle, auf
>deren Basis die Kreuztabelle erstellt wurde?

Hallo Anette,
die Ursprungstabelle ist leider aus Excel importiert, also nicht wirklich eine
Access-Kreuztabelle.
Gruß,
Alex

--
_____________________________________________________________
NewsGroups Suchen, lesen, schreiben mit http://netnews.web.de

[Sascha Wostmann]

Alexander Konopka :

> Hallo,
>
> ich möchte eine vorgegebene (Kreuz)Tabelle der Form
>
> Jan Feb Mär
> Prod1 A B C
> Prod2 D E F
> Prod3 G G I
>
> unter Access umwandeln in
>
> Jan Prod1 A
> Jan Prod2 D
> Jan Prod3 G
> Feb Prod1 B

unter den Voraussetzungen:
- dass es "nur" zwölf Spalten gibt,
- dass die Prod1, Prod2, ... Zeilen die Überschrift "Prod" hat
wäre das mit einer 12-fachen UNION lösbar:

SELECT "Jan" As Monat, Prod, Jan as Wert FROM Kreuztabelle
UNION
SELECT "Feb" As Monat, Prod, Feb as Wert FROM Kreuztabelle
UNION
...
UNION
SELECT "Dez" As Monat, Prod, Dez as Wert FROM Kreuztabelle

Ob Du damit glücklich wirst, musst Du selbst entscheiden. Evtl. bietet
Excel ja auch eine Möglichkeit, die Daten auseinanderzupflücken.

Sascha

--
s...@gmx.de BITTE KEINE FRAGEN PER MAIL - AUCH KEINE KOPIEN VON POSTINGS !
FAQ von Karl unter: http://www.donkarl.com/
Quote of Today :
Zufriedenheit ist Stillstand.

[Fred Hofmann]

Hallo Alexander,

vielleicht hilft Dir ja folgender Ansatz weiter, mit dem ich
mal eine komplette Tabelle in sich "gedreht" habe, d. h. Zeilen in
Spalten und Spalten in Zeilen verwandelt habe. Manches davon
ist etwas proprietärer geworden als geplant, aber es musste halt
fertig werden... Nach etwas intensiverem Studium des Codes
kannst Du es ggf. auf Deine Bedürnisse umstricken.

HTH
Fred

Function holeqkwerte(sWhat As String)
Dim aDruckTitel(11) As Variant
Dim rcs As Recordset
Dim dbs As DataBase
Dim sSelect As String
Dim tdf As TableDef
Dim sTablename As String
Dim nrecords As Integer
Dim rcsSub As Recordset
Dim scode As String
Dim aFolge(11) As Variant

On Error GoTo holeqkwerte_error

aDruckTitel(0) = "geprüft"
aDruckTitel(1) = "A1-Fehler"
aDruckTitel(2) = "A-Fehler"
aDruckTitel(3) = "B-Fehler"
aDruckTitel(4) = "C-Fehler"
aDruckTitel(5) = "A1-Punkte"
aDruckTitel(6) = "A-Punkte"
aDruckTitel(7) = "B-Punkte"
aDruckTitel(8) = "C-Punkte"
aDruckTitel(9) = "Zeit"
aDruckTitel(10) = "Code"
aDruckTitel(11) = "Zeit"

aFolge(0) = 9
aFolge(1) = 1
aFolge(2) = 3
aFolge(3) = 5
aFolge(4) = 7
aFolge(5) = 2
aFolge(6) = 4
aFolge(7) = 6
aFolge(8) = 8
aFolge(9) = 10
aFolge(10) = 11
aFolge(11) = 12

Set dbs = CurrentDb
sTablename = "_MULTI_X_TAB"
dbs.Execute "DELETE _MULTI_X_TAB.* FROM _MULTI_X_TAB;"
If sWhat = "PT" Then
sSelect = "SELECT DISTINCT PT_CODE FROM QK_ABC_4_C"
Else
sSelect = "SELECT DISTINCT MT_CODE FROM QK_ABCMT_4_C"
End If
Set rcs = dbs.OpenRecordset(sSelect)
If Not (rcs.BOF And rcs.EOF) Then
rcs.MoveFirst
Do While Not rcs.EOF
If sWhat = "PT" Then
scode = rcs!PT_Code
Set rcsSub = dbs.OpenRecordset("SELECT QK_ABC_4_C.* FROM QK_ABC_4_C
WHERE QK_ABC_4_C.PT_CODE = '" & scode & "' ORDER BY ZEIT;")
Else
scode = rcs!MT_Code
Set rcsSub = dbs.OpenRecordset("SELECT QK_ABCMT_4_C.* FROM
QK_ABCMT_4_C WHERE QK_ABCMT_4_C.MT_CODE = '" & scode & "' ORDER BY ZEIT;")
End If
If Not (rcsSub.BOF And rcsSub.EOF) Then
turntable rcsSub, sTablename, 255, aDruckTitel, 1, scode, aFolge
Else
MsgBox "Fehler - Leersätze!"
End If
rcsSub.Close
Set rcsSub = Nothing
rcs.MoveNext
Loop
End If
rcs.Close
dbs.Close
Set rcs = Nothing
Set dbs = Nothing
Exit Function

holeqkwerte_error:
MsgBox Err.Description

End Function

Function turntable(rcs As Recordset, sTablename As String, MaxRecord As
Long, aTitel As Variant, nGrpFeld As Integer, sCriterium As String, aFolge
As Variant)
Dim dbs As DataBase
Dim rcsall As Recordset
Dim rcsnew As Recordset
Dim tdf As TableDef
Dim nfields As Integer
Dim nrecords As Long
Dim nCounter As Long
Dim ncounter2 As Integer
Dim ncounter3 As Integer
Dim sFeldname As String
Dim nTitel As Long

On Error GoTo turntable_error

If MaxRecord > 254 Then MaxRecord = 254

Set dbs = CurrentDb

rcs.MoveLast
nrecords = rcs.RecordCount
If nrecords > MaxRecord Then nrecords = MaxRecord
nfields = rcs.Fields.Count
rcs.MoveFirst

' Prüfung Länge des Titel-Arrays, ggf. auffüllen
nTitel = UBound(aTitel, 1)
If nTitel < nfields - 1 Then
ReDim aTitel(nfields - 1)
End If
nTitel = UBound(aFolge, 1)
If nTitel < nfields - 1 Then
ReDim aFolge(nfields - 1)
End If
Set rcsnew = dbs.OpenRecordset(sTablename)

' alle Sätze anlegen
For nCounter = 0 To nfields - 1
rcsnew.AddNew
rcsnew.Update
Next

rcsnew.MoveLast
ncounter3 = 0
For nCounter = (nfields - 1) To 0 Step -1
rcsnew.Edit
rcsnew!Feld0 = aTitel(nCounter)
rcsnew!FELD_GRUPPE = sCriterium
rcsnew!FELD_ANZAHL = nrecords
rcsnew!FELD_SORTIERUNG = aFolge(nCounter)
rcs.MoveFirst
Do While Not rcs.EOF
ncounter2 = rcs.AbsolutePosition
If ncounter2 + 1 < rcsnew.Fields.Count Then
rcsnew.Fields(ncounter2 + 1).value = rcs.Fields(ncounter3).value
End If
rcs.MoveNext
Loop
rcsnew.Update
ncounter3 = ncounter3 + 1
rcsnew.MovePrevious
Next

rcsnew.Close
Set rcsnew = Nothing
dbs.Close
Set dbs = Nothing

Exit Function

turntable_error:
MsgBox Err.Description

End Function