Zeilen transponieren

Winterraven

Grünschnabel
Hallo Zusammen,

vielleicht kann mir einer helfen beim Thema Excel und transponieren.

Gibt es eine Möglichkeit einen Zeilenumbruch einzufügen beim Transponieren?

Ich habe eine Exceldatei mit 2 Spalten (A & B)

Die Spalte A wiederholt sich alle 99 Zeilen. Diese würde ich als Spalten-Kategorien nehmen.

Die Werte aus der Spalte B für die 99 Zeilen sind sind unterschiedlich und genau diese sollen unter einander transponiert werden. Die Anzahl der Zeilen ist ca. 628016

Die Zeile 100 & 101 sind Leere Zeilen und dienen als Trennung.
 

Anhänge

  • ist_soll.GIF
    ist_soll.GIF
    30,1 KB · Aufrufe: 15
Etwa so könnte eine Funktion dazu aussehen

Visual Basic:
Public Sub transformMulti()
    'Werte definieren. DIe Werte könnte man auch als Inputvariabeln umsetzen
    Const C_BLOCK_SIZE = 99          'Blockgrösse
    Const C_SPACE_SIZE = 2          'Anzahl Zeilen zweischen den Datenblöcken
    Const C_SRC_START_ROW = 2       'Erste Zeile der Daten
    Const C_SRC_HDR_COL = "A"       'Spalte des Headers
    Const C_SRC_DAT_COL = "B"       'Spalte der Daten
    Const C_TRG_CELL = "D3"         'Zelle in ab der das Resultat geschrieben wird
   
    'Definitionen
    Dim ws As Worksheet
    Dim rowNum As Long
    Dim firstCell As Range
    Dim trgRng As Range             'Zieltzelle (erste Zelle der Zielzeile)
   
    'Aktives Worksheet auswählen
    Set ws = ActiveSheet
   
    'Header kopieren
    Set firstCell = ws.Range(C_SRC_HDR_COL & C_SRC_START_ROW)
    ws.Range(firstCell, firstCell.Offset(C_BLOCK_SIZE - 1)).Copy
           
    Set trgRng = ws.Range(C_TRG_CELL)
    trgRng.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
   
    'Die Daten kopieren
    Set firstCell = ws.Range(C_SRC_DAT_COL & C_SRC_START_ROW)
    For rowNum = 0 To (ws.UsedRange.Rows.CountLarge \ C_BLOCK_SIZE) - 1
        ws.Range(firstCell, firstCell.Offset(C_BLOCK_SIZE - 1)).Copy
        Set trgRng = trgRng.Offset(1)   'Zielzelle eine Ziele nach untern versetzen
        trgRng.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        'Erste Quellzeile nach unten verschieben
        Set firstCell = firstCell.Offset((C_BLOCK_SIZE) + C_SPACE_SIZE)
    Next rowNum
   
End Sub
 
Etwa so könnte eine Funktion dazu aussehen

Visual Basic:
Public Sub transformMulti()
    'Werte definieren. DIe Werte könnte man auch als Inputvariabeln umsetzen
    Const C_BLOCK_SIZE = 99          'Blockgrösse
    Const C_SPACE_SIZE = 2          'Anzahl Zeilen zweischen den Datenblöcken
    Const C_SRC_START_ROW = 2       'Erste Zeile der Daten
    Const C_SRC_HDR_COL = "A"       'Spalte des Headers
    Const C_SRC_DAT_COL = "B"       'Spalte der Daten
    Const C_TRG_CELL = "D3"         'Zelle in ab der das Resultat geschrieben wird
  
    'Definitionen
    Dim ws As Worksheet
    Dim rowNum As Long
    Dim firstCell As Range
    Dim trgRng As Range             'Zieltzelle (erste Zelle der Zielzeile)
  
    'Aktives Worksheet auswählen
    Set ws = ActiveSheet
  
    'Header kopieren
    Set firstCell = ws.Range(C_SRC_HDR_COL & C_SRC_START_ROW)
    ws.Range(firstCell, firstCell.Offset(C_BLOCK_SIZE - 1)).Copy
          
    Set trgRng = ws.Range(C_TRG_CELL)
    trgRng.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
  
    'Die Daten kopieren
    Set firstCell = ws.Range(C_SRC_DAT_COL & C_SRC_START_ROW)
    For rowNum = 0 To (ws.UsedRange.Rows.CountLarge \ C_BLOCK_SIZE) - 1
        ws.Range(firstCell, firstCell.Offset(C_BLOCK_SIZE - 1)).Copy
        Set trgRng = trgRng.Offset(1)   'Zielzelle eine Ziele nach untern versetzen
        trgRng.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        'Erste Quellzeile nach unten verschieben
        Set firstCell = firstCell.Offset((C_BLOCK_SIZE) + C_SPACE_SIZE)
    Next rowNum
  
End Sub

Oh my fucking goodness :)

Das ist ja TOLL!!!

Merci!
 
Zurück