VBA, um mehrere Spalten mit zwei Zeilen in Excel in eigene Zeilen zu setzen

Question

Ich habe ein Blatt, das so aussieht:

   A   |   B   |   C   |   D   |   E   |
----------------------------------------
     62| Value1| Value2|       |       |
    345| Value3| Value4| Value5| Value6|
     17| Value7| Value0|       |       |
    111| Value8| Value9| ValueA|ValueC |

Ich möchte es folgendermaßen umwandeln (A ist Standard, die nächsten beiden Zellen – B&C, D&E, …):

   A   |   B   | C    |
-----------------------
     62| Value1|Value2|
    345| Value3|Value4|
    345| Value5|Value6|
     17| Value7|Value0|
    111| Value8|Value9|
    111| ValueA|ValueC|

Derzeit verwende ich das folgende Makro, indem ich nur eine Zeile konvertiere, aber ich möchte es mit zwei Zellenwerten.

Sub Transform()

Dim rowStr As String
Dim rowIndex As Integer

rowIndex = 1

For Each Cell In Sheet1.Range("A1:E5")
    If Cell.Column = 1 Then
        rowStr = Cell.Value
    ElseIf Not IsEmpty(Cell.Value) Then
        Sheet2.Cells(rowIndex, 1) = rowStr
        Sheet2.Cells(rowIndex, 2) = Cell.Value
        rowIndex = rowIndex + 1
    End If
Next Cell

End Sub

Answer 1

Ich würde das verwenden.

Sub Transform_2()

Dim c As Range
Dim rngFirstCol As Range
Dim rowIndex As Long
Dim j As Long

rowIndex = 1
Set rngFirstCol = Sheet1.Range(Sheet1.Cells(1, 1), Sheet1.Cells(1, 1).End(xlDown))
For Each c In rngFirstCol
  For j = 0 To rngFirstCol.CurrentRegion.Columns.Count - 2 Step 2
    If c.Offset(, j + 1).Value <> "" Or c.Offset(, j + 2).Value <> "" Then
      Sheet2.Cells(rowIndex, 1).Value = c.Value
      Sheet2.Cells(rowIndex, 2).Resize(1, 2).Value = c.Offset(, j + 1).Resize(1, 2).Value
      rowIndex = rowIndex + 1
    End If
  Next
Next

End Sub

Es wird automatisch entschieden, wie viele Zeilen Ihre Datentabelle hat. Wenn Sie möchten, können Sie dies selbst festlegen, indem Sie

Sheet1.Range(Sheet1.Cells(1, 1), Sheet1.Cells(1, 1).End(xlDown))

zu einemSpaltenverweiswie

Sheet1.Range("A1:A6")