collapse

* Benutzer Info

 
 
Willkommen Gast. Bitte einloggen oder registrieren. Haben Sie Ihre Aktivierungs E-Mail übersehen?

* Wer ist Online

  • Punkt Gäste: 60
  • Punkt Versteckte: 0
  • Punkt Mitglieder: 2
  • Punkt Benutzer Online:

* Forenstatistik

  • stats Mitglieder insgesamt: 13664
  • stats Beiträge insgesamt: 61726
  • stats Themen insgesamt: 8419
  • stats Kategorien insgesamt: 5
  • stats Boards insgesamt: 16
  • stats Am meisten online: 415

Autor Thema: Variable Spaltennamen als Zeilen transponieren  (Gelesen 316 mal)

Offline Knopf

  • Newbie
  • Beiträge: 48
Variable Spaltennamen als Zeilen transponieren
« am: Juni 10, 2017, 20:02:57 »
Hallo Experten!

ich habe eine Tabelle bei der sich einige Spaltennamen wöchentlich ändern. Um mit den Daten weiterarbeiten zu können, müssen die Spaltennamen als Zeilen gespeichert sein. Ich habe die Vorgabe das Ganze in VBA zu programmieren, nicht SQL.

Meine Ausgangstabelle: (Ändert sich wöchentlich, also fortlaufende Kalenderwoche)
Nr  Name    KWn+1     KWn+2    KWn+3
  1     abc         1           2         3

Meine Zieltabelle:
Nr   Name  KW        Anzahl
  1    abc     KWn+1      1
  1    abc     KWn+2      2
  1    abc     KWn+3      3

Bei meiner Suche bin ich auf dieses Makro gestoßen:
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 Long, J As Long
    Dim intNumRecs As Long
    Dim intNumFields As Long

    TransposeTable = False 'Default-Rueckmeldung
    'Recordset für Basis-Tabelle initialisieren
    Set db = CurrentDb()
    Set rsBasis = db.OpenRecordset(strSourceObj)
    rsBasis.MoveLast
   
   
    '1.------------------------------------------------------------------------------------
    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
    '2.-------------------------------------------------------------------------------------
    '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
    '3.--------------------------------------------------------------------------------------
    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
    '4.----------------------------------------------------------------------------------------
    '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
    '5.----------------------------------------------------------------------------------------
    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

 Das funktioniert jetzt, macht aber nicht das was ich mir vorstelle^^ Ab dem 3. Punkt (da wird es erst interessant) komme ich nicht weiter. Es werden die Records gezählt. Ich müsste jetzt aber die Spaltennamen (1-2) anwählen und festlegen, dann einen neuen Spaltennamen für "KW" erstellen. Wie mache ich das? Ich hoffe ihr könnt mir helfen!
Vielen Dank!
lg
Knopf
 

Offline Beaker s.a.

  • Access Guru
  • ****
  • Beiträge: 1454
Re: Variable Spaltennamen als Zeilen transponieren
« Antwort #1 am: Juni 11, 2017, 01:54:00 »
Hallo Knopf,
Auf das gezeigte Beispiel reduziert (Zieltabelle liegt mit gezeigter Struktur vor).
Public Sub Transponse()

    Dim z As Integer
    Dim dbe As DAO.Database
    Dim rstQ As DAO.Recordset
    Dim rstZ As DAO.Recordset

    Set dbe = CurrentDb
    Set rstQ = dbe.OpenRecordset("Quelle")
   
    dbe.Execute "DELETE FROM Ziel"    '<- Zieltabelle wird geleert
    Set rstZ = dbe.OpenRecordset("Ziel")
   
    Do While Not rstQ.EOF
        For z = 2 To rstQ.Fields.Count - 1
            rstZ.AddNew
                rstZ.Fields(0) = rstQ.Fields(0)
                rstZ.Fields(1) = rstQ.Fields(1)
                rstZ.Fields(2) = rstQ.Fields(z).Name
                rstZ.Fields(3) = rstQ.Fields(z).Value
            rstZ.Update
        Next z
        rstQ.MoveNext
    Loop
End Sub
gruss ekkehard
--
Beaker s.a., der lieber an seinem eigenen Projekt arbeiten würde/sollte, aber irgendwie immer gerne seinen Senf dazu gibt ;-)
S.M.I².L.E.
 

Offline Knopf

  • Newbie
  • Beiträge: 48
Re: Variable Spaltennamen als Zeilen transponieren
« Antwort #2 am: Juni 11, 2017, 10:48:40 »
Es hat super funktioniert! Vielen lieben Dank :))
 

Offline volvisti

  • Newbie
  • Beiträge: 2
Re: Variable Spaltennamen als Zeilen transponieren
« Antwort #3 am: August 30, 2017, 19:24:29 »
Hallo Beaker,
Danke für Deinen Tipp.
Hat bei mir auch, nach einer kleinen tabellenabhängigen Änderung, super funktioniert.

Jetzt habe ich den Code als Modul in der Db abgelegt.
Wie kann ich ihn shnell ausführen, ohne über den VBA-Editor gehen zu müssen?
@Knopf wie machst Du das?

Danke schon mal für die Hilfe.

Gruß
Volvisti
 

Offline Knopf

  • Newbie
  • Beiträge: 48
Re: Variable Spaltennamen als Zeilen transponieren
« Antwort #4 am: August 30, 2017, 20:17:22 »
Ich mache das über einen button im formular. Im klassenmodul starte ich dann mein modul. Über modulname.prozedurname .
 

Offline volvisti

  • Newbie
  • Beiträge: 2
Re: Variable Spaltennamen als Zeilen transponieren
« Antwort #5 am: August 31, 2017, 08:53:28 »
Hallo Knopf,
besten Dank.
Ich brauche es zwar nicht wirklich, hab mir aber ein Formular gebaut und die Schaltfläche integriert.
Klappt super.  :)

Schönen Tag noch
volvisti