とあるデータを加工する際に、ある列の複数行に値があるとき特定の行数分だけ値を取り出して別の列に移動させる繰り返し処理が必要だったので、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
ペースト後は不要となった行を削除します。↓
そして Next で返して、この処理を繰り返していきます。
Rows(row_1 + 1 & ":" & row_2).Select
Selection.Delete Shift:=xlUp
Next i
さいごに
実行してみるとわかりますが、この処理は Row_Count で指定した行の末尾まで処理が実行されてしまうので行数が多いとまあまあ時間がかかります。
毎回の処理ごとにコピーした行は消すようにしているので、繰り返し処理の最後のほうは空欄に対して処理を実施することになるのですが、この部分はあきらめて手動で実施するよりはよいと思うことにしました。
コメント