Spalte mit Makro transponieren, je drei Zeilen

Bild

Betrifft: Spalte mit Makro transponieren, je drei Zeilen
von: Sascha
Geschrieben am: 07.08.2015 15:36:14

Hallo allerseits,
ich bin mir sicher, dass ihr mir hierbei behilflich sein könnt.
Mein Arbeitsblatt in Excel sieht im Moment so aus, dass alle Werte in einer einzige Spalte aufgelistet sind.
Es handelt sich dabei jeweils um Blöcke mit je drei Zellen, d.h. Zeile 1-3 gehören logisch zusammen, Zeile 4-6 ebenfalls, usw.
Nun möchte ich diese Werte so transponieren, dass aus jedem Dreier-Block eine einzelne Zeile wird.
Im Forum bin ich bezüglich eines Makros hierfür teilweise schon fündig geworden:


Sub Transponiere()
    Sheets("Blatt1").Range("A1:A3").Copy
    Sheets("Blatt2").Range("A1:C1").PasteSpecial Transpose:=True
End Sub

Dieses Makro macht im Grunde genau das was ich möchte, allerdings hab ich keine Ahnung wie ich den Befehl jetzt auf das restliche Dokument anwende.
Der nächste Schritte wäre ja nun, die Zellen A4:A6 nach A2:C2 zu transponieren.
Die Datei hat tausende dieser Dreier-Blöcke und da sollte es doch eine schlanke Lösung für geben.
VBA-Kenntnisse habe ich bisher leider keine.
Besten Dank schon mal für eure Unterstützung

Bild

Betrifft: AW: Spalte mit Makro transponieren, je drei Zeilen
von: Daniel
Geschrieben am: 07.08.2015 15:59:52
Hi
das schnellste ist, wenn du folgende Formel in B1 einträgst und diese bis Dxxx ziehst (soweit wie benötigt)
=INDEX($A:$A;(ZEILE()-1)*3+SPALTE()-1)
dann Spalten B:C kopieren und an gleicher Stelle als Wert einfügen, dann Spalte A löschen.
sieht als Makros so aus:

With Range("B1").Resize(Worksheetfunction.CountA(Columns(1))/3, 3)
    .formular1c1 = "=Index(C1,(Row()-1)*3+Column()-1)"
    .copy
    .pastespecial xlpastevalues
end with
columns(1).delete
gruß Daniel

Bild

Betrifft: AW: Spalte mit Makro transponieren, je drei Zeilen
von: Sascha
Geschrieben am: 07.08.2015 17:43:14
Super, vielen Dank für die schnellen Antworten. Hat bestens funktioniert =)

Bild

Betrifft: AW: Spalte mit Makro transponieren, je drei Zeilen
von: Sepp
Geschrieben am: 07.08.2015 16:09:00
Hallo Sascha,
eine Möglichkeit,

Sub Transponiere()
Dim lngI As Long, lngN As Long, lngMax As Long
Dim vntOut() As Variant

With Sheets("Blatt1")
  lngMax = Application.Max(3, .Cells(.Rows.Count, 1).End(xlUp).Row)
  Redim vntOut(1 To Clng(lngMax / 3))
  For lngI = 1 To lngMax Step 3
    lngN = lngN + 1
    vntOut(lngN) = Application.Transpose(.Cells(lngI, 1).Resize(3, 1))
  Next
End With

Sheets("Blatt2").Range("A1").Resize(UBound(vntOut), 3) = _
  Application.Transpose(Application.Transpose(vntOut))
End Sub


Gruß Sepp


Bild

Betrifft: AW: Spalte mit Makro transponieren, je drei Zeilen
von: Peter Feustel
Geschrieben am: 07.08.2015 16:14:50
Hallo Sascha,
das Makro sollte deine Wünsche erfüllen.
Gruß Peter

Option Explicit
Public Sub Transformier_mich()
Dim vEingabe    As Variant
Dim vAusgabe()  As Variant
Dim lLetzte     As Long
Dim lIndx_E     As Long
Dim lZeile      As Long
   With ThisWorkbook.Worksheets("Tabelle1") ' den Tabellenblattnamen "Tabelle1" ggf. anpassen
      lLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
      vEingabe = .Range("A1:A" & lLetzte).Value
   End With
   
   ReDim vAusgabe(1 To lLetzte / 3, 1 To 3)
   For lIndx_E = LBound(vEingabe) To UBound(vEingabe) Step 3
       lZeile = lZeile + 1
       vAusgabe(lZeile, 1) = vEingabe(lIndx_E + 0, 1)
       vAusgabe(lZeile, 2) = vEingabe(lIndx_E + 1, 1)
       vAusgabe(lZeile, 3) = vEingabe(lIndx_E + 2, 1)
   Next lIndx_E
       
'     den Tabellenblattnamen "Tabelle2" ggf. anpassen
   ThisWorkbook.Worksheets("Tabelle2").Range("A1:C" & lLetzte / 3).Value = vAusgabe
End Sub


 Bild

Beiträge aus den Excel-Beispielen zum Thema "Spalte mit Makro transponieren, je drei Zeilen"