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

スポンサーリンク
スポンサーリンク

1行1件のデータを1列に列挙する方法

実行結果


実行結果にありますように
データベースのデータを縦方向に列挙するコードをご紹介します。
このコードは項目行がなく、A1セルからデータが始まっっていることが前提です。
意図した結果にならないと困るのでデータはバックアップをとってください。
元に戻すコードは「複数行で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

コードの解説

2行目
【 Dim 番号 As Long】

ワークシートのインデックス番号を格納する変数「番号」を長整数型(Long)で宣言します。


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【オートフィット】メソッドを使用してセルに入力されている値の一番大きい幅に合わせてセルの幅を自動調整します。


以上で
1行1件のデータを1列に列挙する方法についての解説を終了します。
ありがとうございました。

スポンサーリンク
スポンサーリンク

フォローする

スポンサーリンク
スポンサーリンク