Question

我收到错误＆＃34;对象或With块变量未设置＆＃34;在rng_select.Delete行。我没有运气就试过Debug.Print.rng_select.address。我的工作表已激活 - 有任何想法吗？

Sub Delete()

Dim wkb As Workbook
Dim Command As Worksheet, Data As Worksheet, Transfer AsWorksheet, Accredited As Worksheet, FollowUp As Worksheet
Dim LcellData As Long, LcellTransfer As Long, LcellFollowUp As Long, LcellAccredited As Long, a As Long, b As Long
Dim rng_select As Range


Set wkb = Application.ActiveWorkbook
Set Command = wkb.Sheets("Command")
Set Data = wkb.Sheets("Data")
Set Transfer = wkb.Sheets("Transfers")
Set FollowUp = wkb.Sheets("FollowUp")
Set Accredited = wkb.Sheets("Accredited")

LcellFollowUp = FollowUp.Cells(Rows.Count, "A").End(xlUp).Row

FollowUp.Activate

For a = LcellFollowUp To 2 Step -1
   If Cells(a, 8).Value = Cells(a - 1, 8).Value Then
        If rng_select Is Nothing Then
            Set rng_select = Cells(a, 1).EntireRow
        Else
            Set rng_select = Union(rng_select, Cells(a, 1).EntireRow)
        End If
   End If
Next a

rng_select.Delete

Exit Sub

Answer 1

我在rng_select.Delete行上收到错误“Object or With block variable not set”

您收到该错误，因为rng_select什么都不是。这可能是因为代码从未进入If/EndIF循环内的For

要检查，请将此rng_select.Delete更改为

If Not rng_select Is Nothing Then
    rng_select.Delete
Else
    MsgBox "Range not valid"
End If

另外，请避免使用.Activate。您可能希望看到This

您的代码可以写成

Sub Delete()
    Dim wkb As Workbook
    Dim Command As Worksheet, Data As Worksheet, Transfer As Worksheet
    Dim Accredited As Worksheet, FollowUp As Worksheet
    Dim LcellData As Long, LcellTransfer As Long, LcellFollowUp As Long
    Dim LcellAccredited As Long, a As Long, b As Long
    Dim rng_select As Range

    Set wkb = Application.ActiveWorkbook
    Set Command = wkb.Sheets("Command")
    Set Data = wkb.Sheets("Data")
    Set Transfer = wkb.Sheets("Transfers")
    Set FollowUp = wkb.Sheets("FollowUp")
    Set Accredited = wkb.Sheets("Accredited")

    With FollowUp
        LcellFollowUp = FollowUp.Range("A" & .Rows.Count).End(xlUp).Row

        For a = 2 to LcellFollowUp '<~~ No need for reverse loop
           If .Cells(a, 8).Value = .Cells(a - 1, 8).Value Then
                If rng_select Is Nothing Then
                    Set rng_select = .Cells(a, 1).EntireRow
                Else
                    Set rng_select = Union(rng_select, .Cells(a, 1).EntireRow)
                End If
           End If
        Next a
    End With

    If Not rng_select Is Nothing Then
        rng_select.Delete
    Else
        MsgBox "Range not valid. No Matching range found"
    End If
End Sub

删除联合范围错误

1 个答案: