So transponieren Sie eine lange Liste von Zeilengruppen in Spalten (mit Code/Formel)

Question

Ich habe Daten, die ich transponieren möchte, was eigentlich ganz einfach sein sollte. Es gibt jedoch mehrere Zeilen, die ich in Gruppen transponieren muss. Jede letzte Zeile in jeder Gruppe enthält einen bestimmten TEXT, daher weiß ich nicht, ob es eine Möglichkeit gibt, einen Bereich zu erstellen, in dem nach Text statt nach einem Bereich gesucht wird. (Würde das funktionieren? =if(isnumber(search(“TEXT”,A1))Ich habe versucht, ein Makro zu erstellen, aber offensichtlich brauche ich den Code, um die Daten in der Tabelle nach unten zu transponieren, und nicht immer wieder dieselben Daten. Jede Hilfe wäre großartig!

Hier ist eine visuelle Darstellung dessen, was ich brauche (da ich es nicht formatieren kann, sieht es komisch aus, und da ich neu bin, konnte ich es nicht einbetten, also habe ich einen Link zu einer visuellen Darstellung eingefügt, wie die Zeilen/Spalten aussehen/aussehen sollten):

Davon:

Column A
Row A1
Row A2
Row A3
Row A4
Row A5
Row A6
Row A7
Row A8
Row A9
Row A10
Row A11
Row A12
Row A13

Hierzu:

Col A   Col B   Col C   Col D   Col E
Row A1  Row A2  Row A3  Row A4
Row A5  Row A6  Row A7  Row A8  Row A9
Row A10 Row A11 Row A12 Row A13

Hier ist der Loop-Code, den ich gefunden habe:

Sub Test1()
'UpdatebyExtendoffice20161222
      Dim x As Integer
      Application.ScreenUpdating = False
      ' Set numrows = number of rows of data.
      NumRows = Range("A1", Range("A8”).End(xlDown)).Rows.Count
      ' Select cell a1.
      Range("A1").Select
      ' Establish "For" loop to loop "numrows" number of times.
      For x = 1 To NumRows
         ' Insert your code here.

         ' Selects cell down 7 row from active cell.
         ActiveCell.Offset(7, 0).Select
      Next
      Application.ScreenUpdating = True
End Sub

Answer 1

Nehmen wir an, wir beginnen mit:

und wir wollen in Zeilen umorganisieren, wobei das letzte Element in jeder ZeileNeuDieser Code:

Sub ReOrg()
    Dim i As Long, j As Long, N As Long, K As Long
    Dim kk As Long
    i = 1
    j = 2
    K = Cells(Rows.Count, "A").End(xlUp).Row

    For kk = 1 To K
        Cells(i, j).Value = Cells(kk, 1).Value
        j = j + 1
        If Cells(kk, 1).Value = "New" Then
            i = i + 1
            j = 2
        End If
    Next kk
End Sub

wird herstellen: