Question

对编码来说是新手，而VBA是我第一次涉足这一领域。参加了一个工作中的项目，并认为“嘿，也许我可以从中脱颖而出”。

需要经过一列，如果StatCell不等于DateCell，我希望它删除StatCell和右边的三个单元格。重复该行，直到获得StatCell = DateCell，然后向下移动到下一行并重复。

这是到目前为止我得到的代码：

Dim StatRange As Range
Dim StatCell As Range
Dim DateCell As Range
Set DateCell = Range("B1")
Set StatRange = Range("B4:B500")
    For Each StatCell In StatRange
    Do While StatCell.Value <> DateCell.Value
        Range(StatCell.Offset(0, 0), StatCell.Offset(0, 3)).Select
        Selection.Delete Shift:=xlToLeft
    Loop
Next StatCell

它首先工作，并且按预期进行第一次删除，但只能删除一次。然后，我在此行中收到错误424： StatCell.Value <> DateCell.Value

时

是我刚刚删除StatCell并将行移到了引起此错误的原因上吗？我该如何解决？

我感觉到我的错误是基本且显而易见的，但是正如我所说，我对编码非常陌生，可能错过了许多基本课程。任何帮助表示赞赏！

Answer 1

您正在通过StatRange使用StatCell循环。依次将StatCell设置为StatRange中的每个单元格（即对象或范围）。如果删除StatCell，它将变为Nothing，直到范围循环，并且StatCell成为StatRange中的下一个单元格。

使用行号和列号来标识单元格。这些不会成为未引用的，您可以继续循环。

通常，当删除行时，您将自下而上工作，但不会删除整个行（尽管在B：E中可能多次删除，但A列仍保持不变），因此在这种情况下方向并不重要。

with worksheets("sheet1")
    dim i as long

    for i=4 to .cells(.rows.count, "B").end(xlup).row
        do while .cells(i, "B").value2 <> .cells(1, "B").value2 and not isempty(.cells(i, "B"))
            .cells(i, "B").resize(1, 4).delete shift:=xltoleft
        loop
    next i

end with

Answer 2

如果您仍要遍历单元格，请将所有匹配范围添加到变量，然后删除已存储的范围。通常，这比一次删除一个要快。

Dim StatRange As Range, rgDelete As Range
Dim StatCell As Range
Dim DateCell As Range
Set DateCell = Range("B1")
Set StatRange = Range("B4:B500")

For Each StatCell In StatRange.Cells

    If StatCell.Value <> DateCell.Value Then
        If rgDelete Is Nothing Then
            Set rgDelete = StatCell
        Else
            Set rgDelete = Union(StatCell.Resize(, 4), rgDelete)
        End If
    End If

Next StatCell


If Not rgDelete Is Nothing Then rgDelete.Delete xlToLeft

Answer 3

nutsch的代码已编辑。

Sub test()
    Dim StatRange As Range, rgDelete As Range
    Dim StatCell As Range
    Dim DateCell As Range
    Set DateCell = Range("B1")
    Set StatRange = Range("B4:B500")

    For Each StatCell In StatRange.Cells
        If StatCell.Value = DateCell Then Exit For
        'If StatCell.Value <> DateCell.Value Then
            If rgDelete Is Nothing Then
                Set rgDelete = StatCell.Resize(, 4)
            Else
                Set rgDelete = Union(StatCell.Resize(, 4), rgDelete)
            End If
        'End If

    Next StatCell


    If Not rgDelete Is Nothing Then rgDelete.Delete xlToLeft
End Sub

循环运行一次，然后出现“运行时错误'424'：必需对象”

3 个答案: