【VBA】行の値を列に変換させて繰り返し処理してみた

VBA VBA

とあるデータを加工する際に、ある列の複数行に値があるとき特定の行数分だけ値を取り出して別の列に移動させる繰り返し処理が必要だったので、vbaで効率的に処理させることを試してみました

文字で書いているとわかりづらいですが、絵にすると以下のようなことをやります。

行の取り出しの概要図

この図ではA列の値を2行間隔で取り出してC,D列に格納していますが、この取り出す間隔は調整することが可能です。

広告

VBAスクリプト

今回実装したスクリプトは以下です。

Sub Macro1()

Dim i
Dim row_1 As Long
Dim row_2 As Long
Dim Get_Row_Count As Long
Dim Row_Count As Long

'最終行の行番号を取得
Row_Count = Cells(Rows.Count, 1).End(xlUp).Row
    
'何行間隔で取り出すかを定義(取り出したい行数-1を記載)
Get_Row_Count = 1

    'メインの処理
    For i = 1 To Row_Count
        row_1 = i
        row_2 = i + Get_Row_Count
        Range(Cells(row_1, 1), Cells(row_2, 1)).Select
        Selection.Copy
        Cells(row_1, 3).Select
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
        Application.CutCopyMode = False
        Rows(row_1 + 1 & ":" & row_2).Select
        Selection.Delete Shift:=xlUp
    Next i
    
End Sub

スクリプトの解説

上記のスクリプトを解説していきます。

3~7行目は Dim で変数を定義しています。↓

Dim i
Dim row_1 As Long
Dim row_2 As Long
Dim Get_Row_Count As Long
Dim Row_Count As Long

9~10行目では、A列で値が入っている中の最終行の行番号を取得します。↓
A列の末尾側から一番近く値の入っているセルの行番号=A列の最終行の行番号を取得しています。

'最終行の値を取得
Row_Count = Cells(Rows.Count, 1).End(xlUp).Row

12~13行目では、何行間隔で取り出すかを定義します。↓
ここでは取り出したい行数 -1 を記載するようにしてください。

'何行間隔で取り出すかを定義(取り出したい行数-1を記載)
Get_Row_Count = 1

15~27行目がメインの処理です。
まず、[Roe_Count] までfor文を用いて繰り返し処理を実行させて、変数を定義します。 ↓

    For i = 1 To Row_Count
        row_1 = i
        row_2 = i + Get_Row_Count

次に、取り出したい行を選択してコピーをします。↓

        Range(Cells(row_1, 1), Cells(row_2, 1)).Select
        Selection.Copy
行を選択してコピー

その後、上記で選択した行の値を行列入れ替えてC列にペーストします。↓
 ※「Application.CutCopyMode = False」はコピー操作を無効化しています。
  この1行は削除してもマクロとしてはエラーなく実行することが可能です。

        Cells(row_1, 3).Select
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
        Application.CutCopyMode = False
選択した値をC列にペースト

ペースト後は不要となった行を削除します。↓
そして Next で返して、この処理を繰り返していきます。

        Rows(row_1 + 1 & ":" & row_2).Select
        Selection.Delete Shift:=xlUp
    Next i
不要な行の選択
不要な行の削除

さいごに

実行してみるとわかりますが、この処理は Row_Count で指定した行の末尾まで処理が実行されてしまうので行数が多いとまあまあ時間がかかります。

毎回の処理ごとにコピーした行は消すようにしているので、繰り返し処理の最後のほうは空欄に対して処理を実施することになるのですが、この部分はあきらめて手動で実施するよりはよいと思うことにしました。

タイトルとURLをコピーしました