![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?5a7ff87)
縦に並んでいるA,B,C,D のデータを横に行と列を入れ替えて新しいシートA1からマクロを使用して名前が変わったら改行して間を1行開けて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
A列に氏名
B列に日付
C列に開始時間
D列に終了時間
【現状の並び】
氏名1 12/1 開始時間 終了時間
氏名1 12/1 開始時間 終了時間
氏名1 12/3 開始時間 終了時間
・
・
氏名1 12/31 開始時間 終了時間
日付12/31
月末まで氏名1のデータが続きます。
次に氏名2が続きます。
氏名2 12/1 開始時間 終了時間
氏名2 12/2 開始時間 終了時間
氏名2 12/3 開始時間 終了時間
・
・
氏名2 12/31 開始時間 終了時間
・
・
・
・
(上記のようなデータが1000以上続く)
【上記を下記のような形ににしたいです】
氏名1 氏名1 氏名1 氏名1
12/1 12/2 12/3 12/31
開始時間 開始時間 開始時間 開始時間
終了時間 終了時間 終了時間 終了時間
氏名2 氏名2 氏名2 氏名2
12/1 12/2 12/3 12/31
開始時間 開始時間 開始時間 開始時間
終了時間 終了時間 終了時間 終了時間
氏名3 氏名3 氏名3 氏名3
12/1 12/2 12/3 12/31
開始時間 開始時間 開始時間 開始時間
終了時間 終了時間 終了時間 終了時間
【現状先のコードを実行すると】
氏名1 氏名1 氏名1 氏名1
12/1 12/2 12/3 12/31
開始時間 開始時間 開始時間 開始時間
終了時間 終了時間 終了時間 終了時間
氏名2 氏名2
12/1 12/2
開始時間 開始時間
終了時間 終了時間
現状先のコードを実行すると左づめができない状態です。
No.2ベストアンサー
- 回答日時:
以下のようにしてください。
Option Explicit
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
Dim i As Long
Dim name_no As Long '名前番号(1からの通番)
Dim data_no As Long '同一名前内のデータ番号(1からの通番)
name_no = 0
currentName = ""
' ソースシートとターゲットシートの設定
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
'名前が変わったら名前番号に1加算
name_no = name_no + 1
data_no = 1
currentName = wsSource.Cells(i, nameCol).Value
End If
TargetRow = (name_no - 1) * 4 + 1
' 名前、日付、時間1、時間2をターゲットシートに転記
wsTarget.Cells(TargetRow, data_no).Value = currentName
wsTarget.Cells(TargetRow + 1, data_no).Value = wsSource.Cells(i, dateCol).Value
wsTarget.Cells(TargetRow + 2, data_no).Value = wsSource.Cells(i, time1Col).Value
wsTarget.Cells(TargetRow + 3, data_no).Value = wsSource.Cells(i, time2Col).Value
data_no = data_no + 1
Next i
End Sub
No.1
- 回答日時:
こんばんは
>解決法をどなたか教えていただけませんか。
原因は、記入する列のコントロールをしていないことですね。
コード中のコメントで
>' 名前が変わった場合、新しい行に移動
として、記入行を移動(+1)していますけれど、列は何もしていません。
同時に記入列を1(=A列)に戻せば良いのですけれど。
ところが、ご提示のコードでは記入列の制御としては
>For i = 1 To lastRow
というループの中で
>wsTarget.Cells(TargetRow * 4 - 3, i).Value = ~~
のように、元シートの行番号を、記入シートの列番号にしているので列が戻ることがないようになっています。
変数 TargetRow と同じようにして、記入列も制御すればお望みのようにできると思います。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) 日付で矢印マクロ 4 2023/07/25 16:47
- Excel(エクセル) エクセルマクロでデータ出力の際の条件がうまく機能しません。 5 2023/10/01 12:50
- Excel(エクセル) 指定した値以上の中で最小値を出したい 7 2022/10/24 21:12
- Excel(エクセル) エクセルの関数でわからないことあるのでコード付きで教えてください 1 2023/11/28 01:30
- その他(Microsoft Office) outlook vba 予定表 3 2022/11/20 14:51
- Excel(エクセル) エクセルマクロでデータ出力の際の条件がうまく機能しません。 2 2023/09/30 13:01
- docomo(ドコモ) 通話録音が(最初から)自動的に始まるアプリは? 7 2023/01/16 15:53
- Visual Basic(VBA) VBAコードが作動しません。修正したいのですが何処に原因かあるか教えて下さい。 1 2024/01/08 16:23
- Visual Basic(VBA) 【前回の続き続きです、ご教示ください】VBAの記述方法がわかりません。 2 2022/08/24 20:49
- その他(プログラミング・Web制作) GASでガントチャートを作りたいです 1 2022/09/05 17:26
このQ&Aを見た人はこんなQ&Aも見ています
-
賃貸で可能な古民家風レトロな部屋作りのコツ!改めて知る畳の高い機能性と魅力も紹介
畳の部屋を雰囲気のよい部屋に仕上げたい!賃貸住宅でもできる古民家風のレトロな部屋作りのコツを伺った。
-
Excel データの並び替え
Excel(エクセル)
-
エクセルの「パスの定義」の仕方について教えてください
Excel(エクセル)
-
エクセルの表の参照値から円を取って数字で扱えるようにしたい
Excel(エクセル)
-
-
4
ExcelでA列をコピーしたいのですがコピー範囲内に空白セルがあるとそこで終わってしまいます。 全て
Excel(エクセル)
-
5
データから単位文字を除去して計算する方法は?
Excel(エクセル)
-
6
VBAを教えていただきたいです。 添付のような「data sheet」があります。 他に、「集計 s
Visual Basic(VBA)
-
7
ExcelのVBAコードを教えて頂けますでしょうか。 例シート2つがあります。 シート1は元データ
Excel(エクセル)
-
8
ユーザーフォームに別シートからデータを反映させたい。
Visual Basic(VBA)
-
9
エラー表示になってしまいます。
Excel(エクセル)
-
10
Excelで【1-11】と入力すると【1月11日】になってしまう
Excel(エクセル)
-
11
マクロのコードについて教えてください
Visual Basic(VBA)
-
12
範囲の合計の仕方を教えて下さい。
Excel(エクセル)
-
13
特定文字を入ってるCSVの特定の列を特定のexcelシートに取り込みたいです
Visual Basic(VBA)
-
14
A列B列どちらにもあるのを抽出する
Visual Basic(VBA)
-
15
エクセルのcountifのワイルドカードについて
Excel(エクセル)
-
16
excelについて。
Excel(エクセル)
-
17
VBAのことで質問です
Visual Basic(VBA)
-
18
1~複数の連続した行の高さを、各セルの値を読み取って自動で変更したいです
Excel(エクセル)
-
19
ファイル名の日付について教えて頂けますかExcel
Visual Basic(VBA)
-
20
Excel関数かなにかでスムーズに処理するにはあなたならどうしますか?
Excel(エクセル)
関連するカテゴリからQ&Aを探す
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルの保護で、列の表示や...
-
文字の色も参照 VLOOKUP
-
【条件付き書式】countifsで複...
-
Excel複数シートにあるデータを...
-
エクセル マクロ 標準モジュー...
-
Excelでの並べ替えを全シートま...
-
スプレッドシートでindexとIMPO...
-
エクセルで、チェックボックス...
-
Excel の複数シートの列幅を同...
-
エクセルの列の限界は255列以上...
-
ExcelのVlookup関数の制限について
-
VBAで繰り返しコピーしながら下...
-
SUMPRODUCTにて別シートのデー...
-
データを別シートに抽出してリ...
-
Excelに自動で行の増減をしたい...
-
Excelで全てのシートに一気に列...
-
【マクロ】あいうえお順のシー...
-
エクセルのブック分割マクロを...
-
Excel VBA ピボットテーブルに...
-
大量のハイパーリンクを簡単に...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
文字の色も参照 VLOOKUP
-
ExcelのVlookup関数の制限について
-
エクセルの保護で、列の表示や...
-
VBAで繰り返しコピーしながら下...
-
Excel の複数シートの列幅を同...
-
エクセルで横並びの複数データ...
-
エクセルの列の限界は255列以上...
-
【条件付き書式】countifsで複...
-
Excelでの並べ替えを全シートま...
-
SUMPRODUCTにて別シートのデー...
-
エクセル マクロ 標準モジュー...
-
VLOOKアップ関数の結果の...
-
エクセルで、チェックボックス...
-
Excel VBA ピボットテーブルに...
-
オートフィルタ使用時にCOUNTIF...
-
スプレッドシートでindexとIMPO...
-
エクセルVBAで、ある文字を含ん...
-
エクセルのブック分割マクロを...
-
【VBA】複数のシートの指定した...
-
Excel複数シートにあるデータを...
おすすめ情報