Office 2010: Office 2010: Spalten in Zeilen umwandeln

[Alfer Aluminium]

Hallo zusammen,

im Anhang findet Ihr ein Bild mit 2 verschiedenen Excel-Tabellen. Zuerst die Variante wie sie mir zur Verfügung steht und darunter die Version die ich brauche...

Gibt es dafür irgendeine Funktion/Formel, dass ich mir nicht 5 Tage lang die Finger wund tippe?

Es geht um knapp 7.000 Artikel und über 51.000 Zeilen die ich sonst einzelnd zusammenfassen müsste.

Das wäre mir eine Riesenhilfe...

Dankeschön im Voraus

[Beverly]

Hi,

das könntest du mit folgendem Makro machen:

Code: [Auswählen]

Sub Zusammen()
   Dim lngZeile As Long
   Dim lngZiel As Long
   lngZiel = 2
   For lngZeile = 2 To IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count) Step 4
      Worksheets("Tabelle2").Cells(lngZiel, 1) = Cells(lngZeile, 1)
      Worksheets("Tabelle2").Cells(lngZiel, 2) = Cells(lngZeile, 2)
      Worksheets("Tabelle2").Cells(lngZiel, 3) = Cells(lngZeile, 3)
      Worksheets("Tabelle2").Cells(lngZiel, 4) = Cells(lngZeile + 1, 4)
      Worksheets("Tabelle2").Cells(lngZiel, 5) = Cells(lngZeile + 2, 5)
      Worksheets("Tabelle2").Cells(lngZiel, 6) = Cells(lngZeile + 3, 6)
      lngZiel = lngZiel + 1
   Next lngZeile
End Sub
Bedingung ist, dass es tatsächlich immer 4 Zeilen zu jeder Nummer sind und diese fortlaufend untereinander stehen und dass die Aufteilung in die Spalten stets genau so vorliegt wie in dem Beispiel.
Die Daten werden in ein anderes Tabellenblat übertragen, den Namen der Zieltabellenblattes (im Beispiel Tabelle2) musst du also an deine Bedingungen anpassen.

Bis später,
Karin

[Alfer Aluminium]

Hmm Danke für die Hilfe,

leider war das nur eine vereinfachte Form.

Die Nummern haben unterschiedlich viele Zeilen, je nach Menge der angegebenen Attribute...

[Beverly]

Hi,

dann solltest du das Beispiel so hochladen wie es im Original aussieht.

Bis später,
Karin

[Alfer Aluminium]

Salli,

anbei ein Auszug aus der Originaldatei, wieder kommt zu erst die Ursprungsform und darunter die Wunschform.

Gruß und merci

[Beverly]

Hi,

Code: [Auswählen]

Sub Zusammen()
   Dim lngZeile As Long
   Dim lngZiel As Long
   Dim intSpalte As Integer
   lngZiel = 2
   For lngZeile = 2 To IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)
      Worksheets("Tabelle2").Cells(lngZiel, 1) = Cells(lngZeile, 1)
      Worksheets("Tabelle2").Cells(lngZiel, 2) = Cells(lngZeile, 2)
      intSpalte = Cells(lngZeile, 2).End(xlToRight).Column
      Worksheets("Tabelle2").Cells(lngZiel, intSpalte) = Cells(lngZeile, intSpalte)
      If Cells(lngZeile, 1) = Cells(lngZeile + 1, 1) And Cells(lngZeile, 2) = Cells(lngZeile + 1, 2) Then
         Do
            lngZeile = lngZeile + 1
            intSpalte = Cells(lngZeile, 2).End(xlToRight).Column
            Worksheets("Tabelle2").Cells(lngZiel, intSpalte) = Cells(lngZeile, intSpalte)
            If Cells(lngZeile, 1) <> Cells(lngZeile + 1, 1) And Cells(lngZeile, 2) <> Cells(lngZeile + 1, 2) Then Exit Do
         Loop
      End If
      lngZiel = lngZiel + 1
   Next lngZeile
End Sub

Bis später,
Karin