行の値を削除して値を繰り上げる処理

ブログ

行の値を削除しながら値を繰り上げる処理

 上記のような表があった時、№列とMacro列に手を加えずに、黄色部分を削除して値を上に繰り上げる処理を考えてみます。
 4行目と8行目の行全体を削除する方法が使えない時には、どのような方法が考えられるでしょうか?

どのような考え方があるか

 まず、黄色部分を含む行を下からの巡回で行全体を削除し、№列とMacro列に値をふり直す事が考えられます。
 この方法ですと、№列に関しては1からの序数なので特に問題ありません。Macro列は FormulaR1C1 を使えば同じ記述で書けそうです。
 だた、この表の下に数式マクロがあった場合は、行全体の削除で数式マクロが崩れてしまう可能性もあります。
 ここでは、Name列とValue列のみ値で、削除と繰り上げを行ってみましょう。

プログラムコード

'"Delete"表示の行を消して上に詰める
Sub DeleteLine()
    Dim i As Long
    Dim lastRow As Long
    Dim cntUpper As Long
    With ActiveSheet
    
    '削除したい、D,G を"delete"にして削除マーク ①
    .Range("B4") = "delete"
    .Range("B8") = "delete"
    
    lastRow = .Cells(1, "B").End(xlDown).Row    'B列の最終行 ②
    cntUpper = 0  '③
    
    For i = 2 To lastRow
      'Name列が、"delete"であればカウンタ変数をインクリメント ④
        If .Cells(i + cntUpper, "B") = "delete" Then
            cntUpper = cntUpper + 1
        End If
        
        '削除された分だけ上にコピーしていく ⑤
        If cntUpper > 0 Then
            .Range("B" & i + cntUpper & ":C" & i + cntUpper).Copy
            .Range("B" & i & ":C" & i).PasteSpecial Paste:=xlValues
            Application.CutCopyMode = False
        End If
        
        'コピー元の残骸を削除 ⑥
        If i > lastRow - cntUpper Then
            .Range("B" & i & ":C" & i) = ""
        End If
    Next i    '<---- ブレークポイントをここに置いて動作確認する。
    
    End With
    
End Sub

プログラムコード解説

 まず、削除したい行のName列に”delete”とマークを付けておきます。① 
ここは削除されますので、何でも構いません。

 次に②で最終行を得ています。今回は、 
 lastRow = .Cells(Rows.Count, ”B”).End(xlUp).Row
 ではなく、
 lastRow = .Cells(1, “B”).End(xlDown).Row
 としています。これは、真の最終行ではなく、B2セルから下方向に空白となる手前の最終行になります。
 こちらにした理由は、表の下にも値があると想定しているためです。

 ③の cntUpper変数は、どのくらい上方向にずらしてコピーするかのカウント用の変数になります。
 
 For文に関しては上から下方向に巡回させます。行を削除する場合は逆方向に巡回させるのが順当ですが、ここでは上から下に進めます。
 
 ④では、Name列が”delete”の時、カウンタ変数をインクリメントさせています。
 ここで重要なのが、行の指定を、「 i + cntUpper 」としている点です。
If .Cells(i + cntUpper, “B”) = “delete” Then
これに関しては、言葉で説明するよりも、デバッガで動きを確認した方が分かり易いでしょう。

 ⑤に関しては、カウンタ変数が1以上の時、つまり削除対象の行が来た時に、カウンタ分だけ上方向にコピーしています。
 
 最後に、⑥でコピー元の残骸を削除します。実際にはコピーを終えて居残った値を削除する事になります。

動作確認

 実際にどのような手順で処理がなされていくかは、ブレークポイントを置いて確認します。
 For文の折り返しの Next 部分が良いかと思います。

配列を使用したやり方

 もう一つ別の方法を紹介します。変更したい範囲(Range)を二次配列に格納して、必要部分を再度セルに代入していくという方法になります。
 こちらの方が動作をイメージしやすいかもしれません。

'二次配列を使用した例
Sub DeleteLine2()
    Dim i As Long, j As Long
    Dim lastRow As Long
    Dim cnt As Long
    
    With ActiveSheet
    
 
    '削除したい、D,G を"delete"にして削除マーク
    .Range("B4") = "delete"
    .Range("B8") = "delete"
    
    lastRow = .Cells(1, "B").End(xlDown).Row    'B列の最終行
    
    Dim arr
    arr = .Range("B2:C" & lastRow)      'セルの値を二次配列へ

    .Range("B2:C" & lastRow).ClearContents  '値を一旦削除
    
    cnt = 1     'カウンタ変数(値を入力する際の行指定となる)
    For i = 1 To UBound(arr, 1)     '行のループ
        If arr(i, 1) <> "delete" Then
            For j = 1 To UBound(arr, 2) '列のループ
                .Cells(cnt + 1, j + 1) = arr(i, j)
            Next j
            cnt = cnt + 1
        End If
    Next i
    
    End With
    
End Sub

まとめ

 ある限定された列を行単位で削除して、値を繰り上げて行くという処理は頻繁に出てくるわけではありませんが、出来るようになると応用範囲は広がると思います。
 特に、表の下に数式マクロが設置してある場合などでは、いろいろと制限がかかります。
 今回のプログラムは手法としては面白いのではないかと思います。

 その他の方法としては、変更したい範囲を一旦、二次配列に格納して加工し、セルをクリアしてから配列の値を入力していくという方法もあるかと思います。
 ※追記しました。
 一つの問題に対して対処方法は複数あると思いますので、色々とチャレンジしていく事でプログラミングの腕前も上がっていくのではないでしょうか。

コメント

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