Excel VBA 1行1件のデータを1列に列挙する

Sub レコードカラム変換()
 Dim 番号 As Long
 Dim 行数 As Long
 Dim 列数 As Long
 Dim 最終行 As Long
    番号 = ActiveSheet.Index
    Sheets(番号).Range("A1").CurrentRegion.Copy
    Sheets.Add(After:=ActiveSheet).Name = "貼付"
    Range("A1").PasteSpecial Paste:=xlPasteValues, Transpose:=True
    Range("A1").PasteSpecial Paste:=xlPasteFormats
 With Sheets(番号).Range("A1").CurrentRegion
                              .ClearContents
                              .ClearFormats
 End With
    Sheets("貼付").Range("A1").CurrentRegion.Copy Sheets(番号).Range("A1")
    Application.DisplayAlerts = False
      Sheets("貼付").Delete
    Application.DisplayAlerts = True
    Sheets(番号).Select
    行数 = Cells(Rows.Count, 1).End(xlUp).Row
    列数 = Cells(1, Columns.Count).End(xlToLeft).Column
    最終行 = 行数 + 1
    Application.ScreenUpdating = False
 Do While 列数 > 1
    Range("B1", "B" & 行数).Copy
    Range("A" & 最終行).PasteSpecial Paste:=xlPasteValues
    Range("A" & 最終行).PasteSpecial Paste:=xlPasteFormats
    Columns(2).Delete
    列数 = 列数-1
    最終行 = Cells(Rows.Count, 1).End(xlUp).Row + 1
 Loop
    Application.ScreenUpdating = True
    Cells.Rows.AutoFit
    Cells.Columns.AutoFit
End Sub

3行目【Dim 行数 As Long】
A列の最終行番号を格納する変数「行数」を長整数型(Long)で宣言します。

4行目【Dim 列数 As Long】
1行目のデータの最終列番号を格納する変数「列数」を長整数型(Long)で宣言します。

5行目【Dim 最終行 As Long】
A列のデータの最終行番号の次の行番号を格納する変数「最終行」を長整数型(Long)で宣言します。

6行目【番号 = ActiveSheet.Index】
変数「番号」にアクティブシートのインデックス番号を代入します。

7行目【Sheets(番号).Range(“A1”).CurrentRegion.Copy】
Range【ﾚﾝｼﾞ】オブジェクトのCurrentRegion【ｶﾚﾝﾄﾘｰｼﾞｮﾝ】プロパティを使用してアクティブシートのA1セルから始まるデータ範囲を参照してRange【ﾚﾝｼﾞ】オブジェクトのCopy【ｺﾋﾟｰ】メソッドを使用してコピーしてクリップボードに保存します。

8行目【Sheets.Add(After:=ActiveSheet).Name = “貼付”】
Worksheet【ﾜｰｸｼｰﾄ】オブジェクトのAdd【ｱﾄﾞ】メソッドを使用して「貼付」という名前のワークシートを追加します。

9行目【Range(“A1”).PasteSpecial Paste:=xlPasteValues, Transpose:=True】
Range【ﾚﾝｼﾞ】オブジェクトのPasteSpecial【ﾍﾟｰｽﾄｽﾍﾟｼｬﾙ】メソッドを使用してクリップボードに保管されているデータを追加してアクティブになったワークシート「貼付」のA1セルを基準に貼付けます。

貼り付ける内容を表す引数Paste【ﾍﾟｰｽﾄ】には「値のみ」を表す定数を指定し、引数TransposeにTrueを指定して行と列を入替えます。

10行目【Range(“A1”).PasteSpecial Paste:=xlPasteFormats】
もう一つの貼り付ける内容として引数Paste【ﾍﾟｰｽﾄ】に「書式」を表す定数を指定します。

PasteSpecial【ﾍﾟｰｽﾄｽﾍﾟｼｬﾙ】メソッドの引数Paste【ﾍﾟｰｽﾄ】を複数条件にする場合はこのように条件を分けて記述します。

11行目【With Sheets(番号).Range(“A1”).CurrentRegion】
最初のデータがあるシートのA1セルからCurrentRegion【ｶﾚﾝﾄﾘｼﾞｮﾝ】プロパティを使用してデータ範囲を参照しWith【ｳｨｽﾞ】ステートメントで指定します。

12行目【.ClearContents】
11行目で指定したデータ範囲をRange【ﾚﾝｼﾞ】オブジェクトのClearContents【ｸﾘｱｺﾝﾃﾝﾂ】メソッドを使用してデータ範囲の値を削除します。

13行目【 .ClearFormats】
11行目で指定したデータ範囲をRange【ﾚﾝｼﾞ】オブジェクトのClearFormats【ｸﾘｱﾌｫｰﾏｯﾂ】メソッドを使用してデータ範囲の書式を削除します。

これで元データがあるワークシートは値も書式もないワークシートになります。

15行目【 Sheets(“貼付”).Range(“A1”).CurrentRegion.Copy Sheets(番号).Range(“A1”)】
CurrentRegion【ｶﾚﾝﾄﾘｼﾞｮﾝ】プロパティでワークシート「貼付」のA1セルから始まるデータ範囲を参照して、Copy【ｺﾋﾟｰ】メソッドを使用しコピーし、貼付け先を表す引数Destination【ﾃﾞｨｽﾃｨﾈｰｼｮﾝ】に空になっている元データがあったシートの
A1セルを指定します。

16~18行目【Application.DisplayAlerts = False】
Sheets(“貼付”).Delete
Application.DisplayAlerts = True】
一時的にコピーしたデータを貼り付けた、追加したワークシート「貼付」をDelete【ﾃﾞﾘｲﾄ】メソッドで削除します。

削除のアラートが出力されないようにApplication【ｱﾌﾟﾘｹｰｼｮﾝ】オブジェクトのDisplayAlerts【ﾃﾞｨｽﾌﾟﾚｲｱﾗｰﾂ】プロパティにFalseを設定します。

ワークシートの削除が終わったらDisplayAlerts【ﾃﾞｨｽﾌﾟﾚｲｱﾗｰﾂ】プロパティにTrueを設定し止めていたアラートを再開します。

19行目【Sheets(番号).Select】
削除したワークシート「貼付」の内容をコピーされた元データがあったワークシートをアクティブにします。

元データがあったワークシートの内容は図のように1件のデータが各列に振り分けられた状態です。

20行目【行数 = Cells(Rows.Count, 1).End(xlUp).Row】
Cells【ｾﾙｽﾞ】プロパティを使用して、1列目のRows.Count【ﾛｳｽｶｳﾝﾄ】プロパティで取得したセルの最終行からRange【ﾚﾝｼﾞ】オブジェクトのEnd【ｴﾝﾄﾞ】プロパティの移動方向を表す引数に上方向を表す定数を指定し最終行からデータが入力されている最終行まで上方向に移動し、Row【ﾛｳ】プロパティを使用してその行番号を取得し変数「行数」に代入します。

21行目【列数 = Cells(1, Columns.Count).End(xlToLeft).Column】
Cells【ｾﾙｽﾞ】プロパティを使用して、1行目のColumns.Count【ｶﾗﾑｽﾞｶｳﾝﾄ】プロパティで取得したセルの最終列からRange【ﾚﾝｼﾞ】オブジェクトのEnd【ｴﾝﾄﾞ】プロパティの移動方向を表す引数に左方向を表す定数を指定し最終列からデータが入力されている最終列まで左方向に移動し、Column【ｶﾗﾑ】プロパティを使用してその列番号を取得し変数「列数」に代入します。

22行目【最終行 = 行数 + 1】
変数「行数」に1を加算して変数「最終行」に代入します。つまり、データの最終行の1つ下の行を表します

23行目【Application.ScreenUpdating = False】
Application【ｱﾌﾟﾘｹｰｼｮﾝ】オブジェクトのScreenUpdating【ｽｸﾘｰﾝｱｯﾌﾟﾃﾞｨｰﾃｨﾝｸﾞ】プロパティにFalseを設定して次の繰り返し処理の高速化と負担を減らすために画面の更新を抑制します。

24行目【Do While 列数 > 1】
Do While【ﾄﾞｩﾜｲﾙ】ステートメントを使用して繰り返し処理を実行します。繰り返しの条件は変数「列数」の値が1以下になるまで繰り返します。

25行目【Range(“B1”, “B” & 行数).Copy】
B1セルからデータが入力されている最終行数が格納されている変数「行数」まで、つまりB列のデータ範囲をコピーしてクリップボードに保管します。

26~27行目【Range(“A” & 最終行).PasteSpecial Paste:=xlPasteValues】
Range(“A” & 最終行).PasteSpecial Paste:=xlPasteFormats】
変数「最終行」に格納されているデータが入力されている最終行の1つしたの行番号が格納が格納されている変数「最終行」を使用してセルを参照してPasteSpecial【ﾍﾟｰｽﾄｽﾍﾟｼｬﾙ】メソッドを使用して値と書式を貼り付けます。

28行目Columns(2).Delete】
列のコレクションを表すColumns【ｶﾗﾑｽﾞ】プロパティを使用して引数に列のインデックス番号2、つまりB列を参照してDelete
【ﾃﾞﾘｲﾄ】メソッドを使用してB列を削除します。

29行目【列数 = 列数-1】
列を1列削除したので変数「列数」に格納されている列が削除される前のデータが入力されている最終列から1減算して現在のデータが入力されている最終列番号を変数「列数」に代入します。

30行目【最終行 = Cells(Rows.Count, 1).End(xlUp).Row + 1】
現在のA列のデータが入力されている最終行に1を加算して行数を変数「最終行」に代入します。

31行目【Loop】
24行目からここまでの処理を変数「列数」が1以下になるまで繰り返し、すべてのデータをA列に貼り付けます。

32行目【Application.ScreenUpdating = True】
抑止していた画面の更新を再開します。

33~34行目【Cells.Rows.AutoFit
Cells.Columns.AutoFit】
Cells.Rows【ｾﾙｽﾞﾛｳｽﾞ】プロパティですべての行を参照してAutoFit【ｵｰﾄﾌｨｯﾄ】メソッドを使用してセルに入力されている値の一番大きいフォントサイズに合わせてセルの高さを自動調整します。

Cells.Columns【ｾﾙｽﾞｶﾗﾑｽﾞ】プロパティですべての列を参照してAutoFit【ｵｰﾄﾌｨｯﾄ】メソッドを使用してセルに入力されている値の一番大きい幅に合わせてセルの幅を自動調整します。