【VBA】Excelの特定の列が空の場合に特定の範囲の行を自動で詰める方法
こんにちは！大阪市を拠点に活動している『縁紡ぐ』の稲垣です。
SWELLを使ったホームページ制作や、Excel、ACCESS、RPAなどのシステム開発を行っています。
また、Excel、Word、Outlookの研修や、情報セキュリティ研修も行っています。身近なITの相談相手になりたいと思っています。
お気軽にお問い合わせください。
【VBA】Excelの特定の列が空の場合に特定の範囲の行を自動で詰める方法
業務効率化を目指すためVBAは役立ちます。今回は、Excelシートで特定のセルが空白の時に、行を自動で詰めるVBAコードを紹介します。この方法を使えば、手作業での修正が不要になり、時間を大幅に節約できます。
※表示されている名前は、テストデータで実在のデータではありません。
VBAコード２つ紹介
シート関数を使いながら実行手順が見える方法と、配列を使って実行する方法をご紹介します。
高速で動くのは、配列を使って実行する方法です
シート関数を使って実行する方法
以下のコードをExcelのVBAエディタに貼り付けることで、空白行を詰めることができます。
Sub CompactData()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
Dim j As Long
' シート名を設定
Set ws = ThisWorkbook.Sheets("Sheet1") ' シート名を適宜変更してください
' 最終行を取得
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
j = 1 ' 移動先の行番号
' 最初の行から最終行までループ
For i = 1 To lastRow
' B列からE列が全て空白でない場合
If Application.WorksheetFunction.CountA(ws.Range(ws.Cells(i, 2), ws.Cells(i, 5))) > 0 Then
'B列からE列をコピー
ws.Cells(j, 1).Value = ws.Cells(i, 1).Value ' A列の値を保持
ws.Range(ws.Cells(i, 2), ws.Cells(i, 5)).Copy Destination:=ws.Range(ws.Cells(j, 2), ws.Cells(j, 5))
j = j + 1 ' 移動先の行番号をインクリメント
End If
Next i
' 残った行のB列からE列をクリア
If j <= lastRow Then
ws.Range(ws.Cells(j, 2), ws.Cells(lastRow, 5)).ClearContents
End If
MsgBox "行を詰めました"
End Sub
コードの解説
18行目の、If Application.WorksheetFunction.CountA(ws.Range(ws.Cells(i, 2), ws.Cells(i, 5))) > 0 Then
ここで、ワークシートの関数であるCountAを使って未入力かを判断しています。
ws.Range(ws.Cells(i, 2), ws.Cells(i, 5)) の２がB列、5がE列です。こちらを変更することで対象の列を変えることが出来ます
実行結果
ID13は残ったまま、行が詰まりました。
配列を使って実行する方法
以下のコードをExcelのVBAエディタに貼り付けることで、空白行を詰めることができます。
Sub CompactDataWithoutWorksheetFunctions()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
Dim j As Long
Dim data As Variant
Dim output() As Variant
Dim outputRow As Long
Dim cellEmpty As Boolean
' シート名を設定
Set ws = ThisWorkbook.Sheets("Sheet1") ' シート名を適宜変更してください
' 最終行を取得
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
' データ用配列を作成
data = ws.Range("A1:E" & lastRow).Value
' 出力用の配列を作成
ReDim output(1 To lastRow, 1 To UBound(data, 2))
outputRow = 1 ' 出力先の行番号
'データ用配列をループして出力用の配列にコピーして空白行を詰める
For i = 1 To UBound(data, 1)
' B列からE列が全て空白かどうかをチェック
cellEmpty = True
For j = 2 To 5 ' B列からE列を指定
If Not IsEmpty(data(i, j)) Then
cellEmpty = False
Exit For
End If
Next j
' 空白でない行を出力用の配列にコピー
If Not cellEmpty Then
For j = 1 To UBound(data, 2)
output(outputRow, j) = data(i, j)
Next j
outputRow = outputRow + 1 ' 出力先の行番号をインクリメント
End If
Next i
' A列のIDを出力用の配列に書き込む
For i = 1 To outputRow - 1
output(i, 1) = data(i, 1) ' A列のIDを保持
Next i
' 既存のシートをクリア
ws.Range("A1:E" & lastRow).ClearContents
' 出力用の配列をシートに貼り付け
ws.Range("A1").Resize(outputRow - 1, UBound(data, 2)).Value = output
MsgBox "行を詰めました"
End Sub
コードの解説
配列を２つ用意して処理を行います。ひとつは、現在の表の状態、そしてもうひとつは、出力用の未入力行をなくした状態の配列です。
現在の表の配列で入力されている場合➡出力用の配列に値を追加
というのが、基本の考え方です。
30行目の、If Not IsEmpty(data(i, j)) Then で、未入力かどうか判断しています。先ほどは、シート関数を使っていた部分です。
36行目から、出力用の配列に値を追加しています。
まとめ
VBAを使ってExcelの特定の列範囲が空白のときに、行を自動で詰める方法を紹介しました。手作業での修正を省き、業務効率を向上させることができます。ぜひ、実際に試してみてください。
稲垣
- Excel、ACCESSでのシステム開発が得意
- ITスキルを共有し実践的に学びながら成長する人を見るのが幸せ
- 自家焙煎するほどのコーヒー好き
- 使用言語 VBA、Python、Javascript、Java、HTML、CSS etc.
- 保有資格 Kintoneアソシエイト、日商簿記検定２級、マンション管理士、管理業務主任者、情報セキュリティマネジメント、ExcelVBA etc.
- 業務フロー図の作成や業務時間分析を通して、効率化ポイントを探る人
- お客様にとって本当に良いことかを第一に考える人
コメント