Excel データの並び替え

縦に並んでいるA,B,C,D のデータを横に行と列を入れ替えて新しいシートＡ１から添付画像のように、Ｇ列から横に名前別にマクロを使用して名前が変わったら改行して間を１行開けてA列に並べたいのですが、下記のコードでは左詰めができずにうまく動作しません。解決法をどなたか教えていただけませんか。よろしくお願いいたします。

Sub TData()
Dim wsSource As Worksheet
Dim wsTarget As Worksheet
Dim lastRow As Long
Dim TargetRow As Long
Dim nameCol As Long
Dim dateCol As Long
Dim time1Col As Long
Dim time2Col As Long
Dim currentName As String

' ソースシートとターゲットシートの設定
Set wsSource = ThisWorkbook.Sheets("Sheet1) ' ソースシートの名前
Set wsTarget = ThisWorkbook.Sheets.Add ' 新しいシートを作成

' 列のインデックスを設定
nameCol = 1 ' A列
dateCol = 2 ' B列
time1Col = 3 ' C列
time2Col = 4 ' D列

' ターゲットシートの初期行を設定
TargetRow = 1

' 最終行を取得
lastRow = wsSource.Cells(wsSource.Rows.Count, nameCol).End(xlUp).Row

' ソースデータを走査して転記
For i = 1 To lastRow
If wsSource.Cells(i, nameCol).Value <> currentName Then
' 名前が変わった場合、新しい行に移動
TargetRow = TargetRow + 1
currentName = wsSource.Cells(i, nameCol).Value
End If

' 名前、日付、時間1、時間2をターゲットシートに転記
wsTarget.Cells(TargetRow * 4 - 3, i).Value = currentName
wsTarget.Cells(TargetRow * 4 - 2, i).Value = wsSource.Cells(i, dateCol).Value
wsTarget.Cells(TargetRow * 4 - 1, i).Value = wsSource.Cells(i, time1Col).Value
wsTarget.Cells(TargetRow * 4, i).Value = wsSource.Cells(i, time2Col).Value
Next i
End Sub

No.1 ベストアンサー 回答者： tatsumaru77 回答日時： 2024/01/28 19:26

画像が荒くてよくわかりません。

①Sheet1の画像
②マクロ実行後の期待する結果の画像
を提示していただけませんでしょうか。
（広範囲の画像は荒くなるので、少量のデータの方が見やすくなるかと思います）

この回答へのお礼

ご指摘ありがとうございます。訂正したものを再質問させていただきます。

お礼日時：2024/01/28 20:21