行グループの長いリストを列に転置する方法（コード/数式を使用）

Question

転置したいデータがあります。これは簡単なはずです。ただし、複数の行をグループで転置する必要があります。各グループの最後の行には特定のテキストが含まれているため、範囲ではなくテキストを検索する範囲を作成する方法があるかどうかわかりません。(これは機能しますか? =if(isnumber(search(“TEXT”,A1))。マクロを作成しようとしましたが、明らかに、スプレッドシートのデータを転置するコードが必要であり、同じデータを何度も転置する必要はありません。どんな助けでも大歓迎です!

ここに私が必要としているもののビジュアルがあります (フォーマットできないので見た目がおかしく、初心者なので埋め込むことができなかったので、行/列がどのように見えるか/どのように見えるべきかのビジュアルのリンクを含めました:

これから：

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

これに対して:

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

私が見つけたループコードは次のとおりです:

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

まず次のように始めます:

そして、各行の最後の項目が新しいこのコード:

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

生成されます: