Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Suchen nach Nummer und dann Transponieren
#1
Hallo zusammen,

ich habe ein Problem und hoffe darauf, dass jemand von euch eine Elegante Lösung dafür hat.
Anbei die Excel Tabelle.

Ich soll die Buchungen, die im Tabellenblatt Buchungen zu finden sind (gekürzte Version), in das Blatt "Übersicht" Transponieren. Das Problem ist, dass sind ganz viele und ich denke mir das es da auch eine Formel oder VBA Lösungen geben müsste.

Die Teilenummern im Blatt "Übersicht" sind vorgegeben und ab der Spalte F sollen dann die einzelnen Buchungen mit den Mengen transponiert werden.

Danke und Gruß


Angehängte Dateien
.xlsx   transponieren.xlsx (Größe: 14,62 KB / Downloads: 12)
Antwortento top
#2
Hallo

ich weiß nicht, wo die Datumangaben, die Zahl 101 und die Bezeichnung herkommen.

Auch nicht die Daten ab Zeile 102.
Das passt nicht zur Übersicht...

Ich kann das anbieten:
Code:
Sub Makro1()
    Dim TB1 As Worksheet, TB2 As Worksheet, i As Long, LR As Long, LC As Integer, Z As Long
    Dim Z1 As Integer, S1 As Integer, Neu1 As Integer, Arr As Variant
   
    Set TB1 = Sheets("Übersicht")
    Set TB2 = Sheets("Buchungen")
    Z1 = 2 ' Daten ab Zeile 2
    S1 = 6 'Daten ab Spalte 6=F
    Neu1 = 4 'Zielzeile
   
    'reset
    TB2.UsedRange.Clear
   
    LR = TB1.Cells(TB1.Rows.Count, 1).End(xlUp).Row 'letzte Zeile der Spalte
   
    For i = 2 To LR
        LC = TB1.Cells(i, TB1.Columns.Count).End(xlToLeft).Column 'letzte Spalte einer Zeile
           
        With TB2.Cells(Neu1, 1)
            'Material kopieren
            .Value = TB1.Cells(i, 1)
           
            If LC >= S1 Then 'Prüfen, ob Daten vorhanden sind
                'Buchungen kopieren
                Arr = WorksheetFunction.Transpose(TB1.Cells(i, S1).Resize(1, LC - S1 + 1).Value)
                .Offset(1, 3).Resize(LC - S1 + 1, 1).Value = Arr
               
                'Leerzeile ergängen
                Neu1 = Neu1 + LC - S1 + 3
            Else
                'Leerzeile ergängen
                Neu1 = Neu1 + 2
            End If
               
           
           
        End With
    Next
End Sub


LG UweD
Antwortento top
#3
Hallo. Es könnte so schön einfach sein (mit Power Query). Aber bei dieser Tabelle (die keine ist) mache ich mir nicht die Mühe, daraus eine vernünftige (auswertbare) Tabelle zu machen ...
Gruß Jörg

"Wer immer tut, was er schon kann, bleibt immer das, was er schon ist." - Henry Ford
Antwortento top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste