エラー回避して範囲内の空白セルを見つけたら上方向に詰める

上方向に詰めるセルの操作

エクセルを使っていると表を扱う事が多いと思いますが、不要なデータを消去した時や条件に合わない場合は消去することで、表の中の範囲内に空白セルができてしまいます。

当然空白セルは不要なので、範囲内の空白セルを見つけたら上方向に詰めたいと思ったことありませんか?

そこで、表の範囲内を上から順番に調べて空白セルを見つけたら、その下方向に入力済み最初のセルの値をコピーして見つけた空白セルに張り付ける方法を繰り返してできるようにします。

これを自動的に繰り返して処理を行う事で画像のように空白セルを詰めることができるようになります。

スポンサーリンク

範囲内の空白セルを見つけたら上方向に詰めるVBAコード

見た目では同じ結果になる方法として、範囲内の空白セルを見つけたらわざわざ「切り取り」➡「貼り付け」を繰り返すのではなく「削除」する方法もありますが、削除した場合には削除されたセルがどこかのセルから数式などでリンクされている場合などエラーになってしまいます。

その為にここでは空白セルを見つけたら削除ではなく、データ(値)のコピー・貼り付けを繰り返すことによりリンクエラーを起こさないようにして上方向に詰める方法を行います。

ここで紹介するVBAコードは、ユーザーフォームに配置したコマンドボタンを押すことにより、表の範囲をセルA1~E15として空白セルを見つけたら同じ行のデータ(値)も一緒に、上方向に詰めるようにします。

ただし、A列は通し番号の為に空白セルと同じ行にあっても詰めないようにしています。

空白セルを見つけたら上方向に詰める

Private Sub CommandButton1_Click()
If Cells(2, 2) = “” And Cells(3, 2) = “” Then
Range(Cells(2, 2), Cells(2, 5)).Value = Range(Cells(2, 2).End(xlDown), Cells(2, 5).End(xlDown)).Value
Range(Cells(2, 2).End(xlDown), Cells(2, 5).End(xlDown)) = “”
ElseIf Cells(2, 2) = “” Then
Range(Cells(2, 2), Cells(2, 5)).Value = Range(Cells(2, 2).End(xlDown), Cells(2, 5).End(xlDown)).Value
Range(Cells(2, 2).Offset(1, 0), Cells(2, 5).Offset(1, 0)) = “”
End If
For i = 1 To 15
If Cells(i, 2) = “” Then
C = Range(Cells(i, 2).End(xlDown), Cells(i, 5).End(xlDown)).Value
Range(Cells(i, 2).End(xlDown), Cells(i, 5).End(xlDown)) = “”
Range(Cells(1, 2).End(xlDown).Offset(1, 0), Cells(1, 5).End(xlDown).Offset(1, 0)) = C
End If
Next i
End Sub

VBA解説
  1. コマンドボタン1がクリックされたら
  2. もしセルB2とセルB3がそれぞれ空白だったら
  3. セルB2~E2の範囲の値をセルB2~E5から下方向へ探して最初の入力済みセルの値にする
  4. セルB2~E5から下方向へ探して最初の入力済みセルの値を空白にする
  5. そうではなく、もしセルB2が空白だったら
  6. セルB2~E2の範囲の値をセルB2~E5から下方向へ探して最初の入力済みセルの値にする
  7. セルB2~E5から1行下方向のセルの値を空白にする
  8. Ifステートメント終了
  9. 変数「i」を宣言して変数は1~15とする
  10. もしセルi行目の2列目の値が空白だったら
  11. セルi行目の2列目の入力済み最初のセルからセルi行目の5列目の入力済み最初のセルの値を変数「C」に格納する
  12. セルi行目の2列目の入力済み最初のセルからセルi行目の5列目の入力済み最初のセルの値を空白にする
  13. セルB1~E1の範囲から下方向へ入力済み最終行の1行下のセルに格納した「C」の値を記載する
  14. Ifステートメント終了
  15. 変数「i」を繰り返す
  16. マクロ記録終了

上記VBAコードは現在表示中のシートにユーザーフォームを表示して空白セルを見つけたら上方向に詰めるようになっています。

また、上記サンプルは15行・5列だけの空白セルを見つけたら上方向に詰める狭い範囲なので、VBAコード実行中の画面のチラつきや処理の遅さを感じませんが、範囲が広くなる場合はちらつき防止処理をするVBAコードを付け加えておくことをおススメします。

スポンサーリンク

使用したVBAコードの解説

範囲内の空白セルを見つけたら上方向に詰めるVBAコードをまとめると上記のようになりますが、3つのブロックに分かれていますので、もう少し細かく分解してVBAコードを見てみましょう。

リストの1行目と2行目が空白セルの時にエラー回避

2行目~5行目までが1つのブロックになっていて、リストの範囲内の1番目と2番目の両方が空白セルが絶対ないとは言えないので、Ifステートメントで記述しています。

このリスト内の1番目・2番目両方が空白の時の処理をすることにより、1行目に必ず値が入力されている状態を作り、For~Nextの繰り返し処理で2行目以降から作業ができるようにしています。

この記述が無いと3行目の値を1行目に詰めることができずにリストみんな空白になり消えてしまいます。

リストの1行目が空白セルの時にエラー回避

次のブロックが6行目~9行目までになっていて、先ほどは1番目と2番目の両方でしたが、今度は1番目だけ空白セルだった場合をIfステートメントで記述しています。

このリスト内の1番目が空白の時の処理は先ほどとほぼ同じなのですが、データをコピーした後に空白にするセルの部分が異なります。

1行だけ空白だったセルが値で埋まるという事は、空白セルが無くなっている状態になっているので、入力済み最終行を探しに行ってしまうとリストの一番最後のセルが該当するので、ここが消去されてしまいます。

リストが1つ減っていしまい、さらに2番目の値が1行目にもコピーされているのでダブってしまいます。

繰り返し処理で空白セルを詰める

実は最初にこのブロックの11行目~17行目、繰り返し処理だけ記述した空白セルを詰めるのに使っていたのですが、たまたま、リストの最初のデータを消去する必要があり、いつも通り詰めるボタンを押したらエラーになったので、今回修正しました。

変数「i」で1行目~15行目だけど実質3行目から開始

先の2つのIfステートメントにより、必ず1行目はタイトルで2行目に1つ目のデータが入力済みになっているので、実質3行目から15行目まで1行ごとにチェックして、空白セルが見つかった時に詰めるように処理ができます。

C=と記述して見つけたデータを「C」という名で格納

空白セルを見つけたら.End(xlDown)と記述することにより、見つけたセルから下方向で最初に見つけた入力済みセルの値を取得することができます。

.End(xlDown)を使う事により、空白セルが1行下でも10行下でも何でもよくて、とにかく最初に見つけたセルの値となります。

そして見つけた値をすぐに空白セルに張り付けるて詰めるのではなく、データを取得したのでそのセルは用済みなので先に空白にしておいてから取得したデータをセルに張り付けるので、一旦バックアップが必要になります。

そこで、「C」という名で格納(バックアップ)しますが、この「C」という名は適当に付けただけで、CopyのCを取っただけです。

バックアップをしたら、見つけたデータを空白にしてダブって使わないようにしています。

格納した値を取り出して入力済み最終行の1行下に追記

バックアップしておいたデータ「C」を呼び出して、Range(Cells(1, 2).End(xlDown).Offset(1, 0), Cells(1, 5).End(xlDown).Offset(1, 0))とすることによりセルB1~E1の範囲内それぞれの入力済み最終行を見つけて、その1行下のセルに格納した「C」を記述しています。

あとは、15行目まで繰り返してくれるので、空白セルを見つけたら詰めることができます。

とりっぷぼうる
とりっぷぼうる

VBAコードがちょっと長くなりましたが、この方法が行削除していないので、表の範囲内のセルに数式などでリンクされていても、リンクエラーにはなりませんよ。

特にリンクしていない場合は、CutとPasteを使う事もできますよ。

スポンサーリンク

CutとPasteを使って空白セルを詰める

空白セルを詰めて表を整理したいと誰もが思いますが、VBAコードが分からない時は「マクロの記録」を使って試してみる事多いと思います。

そうするとデータを【切り取り】をして【貼り付ける】を行うとCutとPasteが使われていますので、これを応用して最初は試してみたら、結果は空白セルを詰めることができたのです。

ただし、切り取ったセルに数式などで絶対番地でのリンクをしていたらエラーになる場合があるのご注意を。

CutとPasteを使って空白セルを詰める

Private Sub CommandButton1_Click()
For i = 1 To 15
If Cells(i, 2).Value = “” Then
Range(Cells(i, 2).End(xlDown), Cells(i, 5).End(xlDown)).Cut
Cells(i, 2).Select
ActiveSheet.Paste
End If
Next i
End Sub

繰り返すとか空白セル見つけるというのを後回しにして、そもそもセルの値を移動(切り取りして貼り付け)するには、CutとPasteを使います。

最初の画像にもあったように空白セルが「B4」なので、セルB5の値を切り取りセルB4に貼り付けましょう。

ちなみにセルB4は4行目の2列目なのでCells(4,2)、セルB5は5行目の2列目なのでCells(5,2)となります。

切り取りして貼り付ける

Private Sub CommandButton2_Click()
Cells(5, 2).Cut
Cells(4, 2).Select
ActiveSheet.Paste
End Sub

2行目の変数1~15が表の空白を調べる範囲でもある1行目から15行目となります

3行目のCells(i,2)で1行目の2列目(セルB1)から順番にセルB15まで空白セルの条件に合うセルを探します。

4行目のRangeを(セル、セル)で囲む事により2列目~5列目まで行を指定し、End(xlDown)で見つけた空白セルから入力済み最初に見つけたセルをCutで切り取ります。(移動させる)

5行目で空白セルを選択してCutしたデータを6行目で貼り付けることにより、切り取ったもともとあったデータ(値)は空白セルになっています。

この作業を15行目まで繰り返すことにより、空白セルを見つけたら上方向に詰めることができるようになります。

スポンサーリンク


セルの操作
スポンサーリンク
参考になりましたらシェア宜しくお願い致します

山頂テラスデッキからの三段紅葉(2019年11月)

フリーパスって助成金つぎ込んでいいの?

コロナ禍のGo To トラベル以外にも助成金だらけでうらやましいね。

安くなったフリーパスで遊びに行きたいけど、給与も減って余裕ないよね。

Excel VBA