ExcelVBA:Transform data from multible rows into one.

MultiRowsIntoOne.vb

Option Explicit

Public Sub 複数行を単一行へ変換()
    Dim 入力シート As Worksheet
    Dim 出力シート As Worksheet
    Dim 入力行 As Integer ' 入力シートのキーの行番号
    Dim 入力列 As Integer ' 入力シートの値の列番号
    Dim 出力行 As Integer ' 出力シートの出力行番号
    Dim 出力列 As Integer ' 出力シートの出力列番号
    Dim 値列数 As Integer ' 値の列数
    
    Set 入力シート = Worksheets("Sheet1")
    Set 出力シート = Worksheets("Sheet2")
    入力行 = 1
    入力列 = 2
    出力行 = 1
    出力列 = 2
    値列数 = 2
    
    Do While 入力シート.Cells(入力行, 1).Value <> ""
      If 入力シート.Cells(入力行, 1).Value <> 出力シート.Cells(出力行, 1).Value Then
        出力行 = 出力行 + 1
        出力列 = 2
        出力シート.Cells(出力行, 1).Value = 入力シート.Cells(入力行, 1).Value
      Else
        出力列 = 出力列 + 値列数
      End If
      
      Dim i As Integer
      For i = 0 To 値列数
        出力シート.Cells(出力行, 出力列 + i).Value = 入力シート.Cells(入力行, 入力列 + i).Value
      Next i
                        
     
      入力行 = 入力行 + 1
    Loop

End Sub