Tabelle erstellen

Hallo Ronja,

wenn du die andere Tabelle dem Datenmodell hinzufügst, musst du eine Beziehung dazu erstellen:

Bericht => stundentsid zu Tabelle => studentsid

Danach ziehst du das Geschlecht in den Zeilenbereich.

Oder du bringst das Geschlecht mit einem SVERWEIS in die bestehende Tabelle mit den Klicks und erstellst dann aus der erweiterten Tabelle eine neue Pivot-Tabelle.

Claus

danke

habs aber leichter gelöst

alles in tabelle umwndeln, und ab damit nach excel das ist einfacher

Hallo,

1. Strg+H | Erweitern

2. Suchen nach: , (ein Komma plus Leerzeichen eingeben)

3. Ersetzen durch: ^t (Sonderformat | Tabstoppzeichen)

4. Alle ersetzen

5. Suchen nach: - (Leerzeichen plus Minuszeichen plus Leerzeichen)

6. Ersetzen durch: ^t

7. Alle ersetzen

8. Liste markieren

9. Einfügen | Tabelle | Text in Tabelle umwandeln | Text trennen bei Tabstopps | OK

Viele Grüße

Lisa

Hallo nochmals,

sortiere deine Tabelle1 nach Position. Sonst würde in dem Beispiel C vor A kommen, weil C der erste Eintrag ist.

Und dann probiere es so:

Sub Transponieren()

Dim c As Range

Dim LRow As Long, i As Long, myCol As Long, n As Long

Dim arrSearch As Variant, arrHeader As Variant, arrTemp As Variant

Dim myDic As Object

Dim FirstAddress As StringWith Sheets("Tabelle1")

   LRow = .Cells(Rows.Count, 1).End(xlUp).Row

   .Columns("B:B").AdvancedFilter Action:=xlFilterCopy, _

      CopyToRange:=Sheets("Tabelle2").Range("A1"), Unique:=True

   arrTemp = .Range("C2:C" & LRow)

   Set myDic = CreateObject("Scripting.Dictionary")

   For i = LBound(arrTemp) To UBound(arrTemp)

      myDic(arrTemp(i, 1)) = arrTemp(i, 1)

   Next

   arrHeader = myDic.items

End WithWith Sheets("Tabelle2")

   LRow = .Cells(Rows.Count, 1).End(xlUp).Row

   arrSearch = .Range("A2:A" & LRow)

   .Range("B1").Resize(1, myDic.Count) = arrHeader

   

For i = LBound(arrSearch) To UBound(arrSearch)

   Set c = Sheets("Tabelle1").Range("B:B").Find(arrSearch(i, 1), _

      LookIn:=xlValues)

   If Not c Is Nothing Then

      FirstAddress = c.Address

      Do

         For n = LBound(arrHeader) To UBound(arrHeader)

            If arrHeader(n) = c.Offset(, 1) Then

               myCol = n + 2

               Exit For

            End If

         Next

         .Cells(i + 1, myCol) = IIf(Len(.Cells(i + 1, myCol)) = 0, _

            c.Offset(, -1), .Cells(i + 1, myCol) & Chr(10) & c.Offset(, -1))

         Set c = Sheets("Tabelle1").Range("B:B").FindNext(c)

      Loop While Not c Is Nothing And c.Address <> FirstAddress

   End If

Next

End With

End Sub

Mit freundlichen Grüßen

Claus

Hallo Andreas und Claus,

ihr seid spitze! Vielen Dank für eure schnellen Antworten, das ist ja unglaublich! Einfach klasse!!!

Wie du bereits schreibst, Andreas, ist die Lösung vn Klaus tatsächlich dynamischer und einfacher zu handhaben. Daher beziehe ich mich in meiner Antwort auf diese Lösung.

Dein Code, Klaus, funktioniert in meiner Beispieldatei sehr gut. Jetzt habe ich jedoch versucht das Makro auf mein Originalfile anzuwenden (aus Datenschutzgründen darf ich dies nicht posten). Ich habe die Reiter entsprechend genannt. Die Spaltenbeschriftungen
unterscheiden sich. Und es sind nun 1190 Datensätze.

Beim Ausführen des Codes wird dieser Fehler in folgender Zeile angezeigt

run-time error '5':

Invalid procedure call argument

myCol = Asc(c.Offset(, 1)) - 63

Ich bin kein Experte, was Makros und Module angeht. Daher habe ich keine Ahnung, wie ich den Fehler beheben kann. Könnt ihr mir weiterhelfen?

Nochmals & weiterhin ein riesengroßes DANKESCHÖN!