VBA 空白行削除して上につめる その2

Question

お世話になっております。皆様にアドバイスを頂きながら、四苦八苦しながら
コードを書いております。空白行の削除＆上に詰める処理で、どうしてもエラーが
でてしまい、朝から四苦八苦しております。

下記コードを実行すると、しっかりと、D列、E列は空白セルを削除し、
上に詰めることができました。以下の画像参照。
コード抜粋

'D列、E列の空白行を削除して上に詰める

Dim D_MaxRow As Long 'D列に格納さている最大行数
Dim Dell_Row As Long '削除する行

D_MaxRow = Cells(Rows.Count, 4).End(xlUp).Row

For Dell_Row = D_MaxRow To 3 Step -1
    If Cells(Dell_Row, 4) = "" Then

        Range(Cells(Dell_Row, 4), Cells(Dell_Row, 5)).Delete shift:=xlShiftUp
    End If
Next Dell_Row

しかし、F列も空白セルを削除して上に詰めたいと思い、以下のコードを実行したところ、Range(Cells(Dell_Row, 6)).Delete shift:=xlShiftUpのコードで、

Rangeメソッドは失敗しました。'_Global'オブジェクトと出てエラーとなってしまいます。
ちなみに、デバックしてみた所、Dell_Rowには7が入っているので、ループの中を
1週はしている感じです。

コード抜粋

'F列の空白行を削除して上に詰める

Dim F_MaxRow As Long
F_MaxRow = D_MaxRow

For Dell_Row = F_MaxRow To 3 Step -1
    If Cells(Dell_Row, 6) = "" Then
        Range(Cells(Dell_Row, 6)).Delete shift:=xlShiftUp
    End If
Next Dell_Row

なぜ、エラーとなってしまうのでしょう？？また、
D列、E列、F列の空白セルを一辺に削除し、上に詰める方法はないものでしょうか？

コード全体

'差分抽出マクロ

Sub test1()
Dim i As Long '作業前用カウンタ変数
Dim j As Long '作業後用カウンタ変数
Dim diff As Long '差分書き出し用変数
Dim A_MaxRow As Long
Dim D_MaxRow As Long
Dim F_MaxRow As Long
Dim Dell_Row As Long

'作業前のMACを元に作業後のMACアドレスの比較を行う
i = 3
    Do While Cells(i, 1).Value <> ""
        j = 3
        Do While Cells(j, 4).Value <> ""
            If Cells(i, 1) = Cells(j, 4) Then
                Cells(i, 3).Value = "after_match" '作業後のMAC有り
            End If
            j = j + 1
        Loop
        i = i + 1
    Loop

'作業後のMACを元に作業前のMAアドレスんの比較を行う
j = 3
    Do While Cells(j, 4).Value <> ""
        i = 3
        Do While Cells(i, 1).Value <> ""
            If Cells(j, 4) = Cells(i, 1) Then
                Cells(j, 6).Value = "befor_match"
            End If
            i = i + 1
        Loop
        j = j + 1
    Loop

'xx_matchが無いものが差分なので別セルへ抜き出す
'作業前でafter_matchが無いMACとホスト名を別セル(h列、i列)へ抜き出す
diff = 3
A_MaxRow = Cells(Rows.Count, 1).End(xlUp).Row

    For i = 3 To A_MaxRow
         If Cells(i, 3).Value <> "" Then
   
        Else
             Range(Cells(i, 1), Cells(i, 2)).Cut Destination:=Range(Cells(diff, 8), Cells(diff, 9))
            diff = diff + 1
        End If
    Next i
    
    
'作業後でbefor_matchが無いMACとホスト名を別セル(j列、l列)へ抜き出す
diff = 3
D_MaxRow = Cells(Rows.Count, 4).End(xlUp).Row

    For j = 3 To D_MaxRow
        If Cells(j, 6).Value <> "" Then
            
        Else
            Range(Cells(j, 4), Cells(j, 5)).Cut Destination:=Range(Cells(diff, 10), Cells(diff, 11))
            diff = diff + 1
        End If
    Next j
    

'D列、E列の空白行を削除して上に詰める

For Dell_Row = D_MaxRow To 3 Step -1
    If Cells(Dell_Row, 4) = "" Then

        Range(Cells(Dell_Row, 4), Cells(Dell_Row, 5)).Delete shift:=xlShiftUp
    End If
Next Dell_Row

'F列の空白行を削除して上に詰める

F_MaxRow = D_MaxRow

For Dell_Row = F_MaxRow To 3 Step -1
    If Cells(Dell_Row, 6) = "" Then
        Range(Cells(Dell_Row, 6)).Delete shift:=xlShiftUp 'ここでエラーになる。
    End If
Next Dell_Row
              
End Sub

どなたかご教授下さい。

Answer 1

いっぺんに消すならば、
「処理したい範囲」を定義して
「その範囲の空欄のセルを消す」という流れでどうでしょうか。

Sub test2()
Dim MyRng As Range
Set MyRng = Range(処理したい範囲) '処理したい範囲を定義
MyRng.SpecialCells(xlCellTypeBlanks).Delete shift:=xlShiftUp '範囲に含まれる空白セルを削除
End Sub

Comments

[退会済みユーザー]

処理したい範囲が固定なら、アドバイスいただいた方法でも良いと思いますが、
可変であるため、ちょっと違う方法の方がよいです。

Range(Cells(Dell_Row, 6)).Delete shift:=xlShiftUpのコードのエラーさえ解決できれば
できるのですが・・・・。

本日、ず～と考えていますが、未だにエラーの原因がわかりません。。。。

[macinspire]

rangeを使わず
Cells(Dell_Row, 6).delete shift～
では、どうですか？

[退会済みユーザー]

確かに、Rngeを使わずに Cells(Dell_Row, 6).Delete shift:=xlShiftUpとしたらエラー無なく実行でき意図したとおりの処理が行われました。

しかし、
Range(Cells(Dell_Row, 6)).Delete shift:=xlShiftUp 'エラーとなるコードと
Cells(Dell_Row, 6).Delete shift:=xlShiftUpは一体何が違うのでしょう？

原因がさっぱり分かりません。。。

[macinspire]

試しにもとのコードを
Range(Cells(Dell_Row, 6),Cells(Dell_Row, 6))
とされると、おそらくエラーは出ないと思います。

rangeで、セル１つを書くのは文法ミスです。
（エクセルが、そのようにエラーメッセージを出してほしいものですが）

[macinspire]

若干訂正します。
range()の中にはテーブル名を入れることができます。
range("変換表")
range(cells(a,b))と書くと
range(cells(a,b).value)と同義なので
cells(a,b)の値をテーブル名とみなして参照するので「存在しない」と解釈されていると思われます。
※推測を含みます。