Question

结果：查找并删除范围中的值并向上移动单元格。

我的代码中存在无限循环的问题。我相信问题可能出在LastCell上。

我需要找到范围内的所有0。选择，删除和移动单元格。

sub(FindAllDelete)

Dim EmptyCells As Range
Dim LastCell As Range
Dim FirstAddr As String

With Worksheets("Sheet1").Range("F30:W1000")
Set LastCell = Range("W1000")
End With
Set EmptyCells = Worksheets("Sheet1").Range("F30:W1000").Find(What:="0", After:=LastCell)

If Not EmptyCells Is Nothing Then
    FirstAddr = LastCell.Address
End If

  Do Until EmptyCells Is Nothing
     Debug.Print EmptyCells.Address
     Set EmptyCells = Worksheets("Sheet1").Range("F30:W1000").FindNext(after=EmptyCells)
    If EmptyCells.Address = FirstAddr Then
  Exit Do
    End If
    Loop
    EmptyCells.Delete Shift:=xlShiftUp

Answer 1

我更喜欢@Shai Rado给出的答案，因为它不涉及任何循环，但是说我写了代码所以我要发布它....

这样联合所有0范围，或者你可以在找到它们时删除它们，然后继续循环直到EmptyCells Is Nothing。

Public Sub FindAllDelete()

    Dim EmptyCells As Range
    Dim AllCells As Range
    Dim FirstAddr As String

    With Worksheets("Sheet1").Range("F30:W1000")
        Set EmptyCells = .Find(0)

        If Not EmptyCells Is Nothing Then
            FirstAddr = EmptyCells.Address
            Do
                If EmptyCells.Address = FirstAddr Then
                    Set AllCells = EmptyCells
                Else
                    Set AllCells = Union(AllCells, EmptyCells)
                End If

                Set EmptyCells = .FindNext(EmptyCells)

            Loop While EmptyCells.Address <> FirstAddr
        End If

    End With

    AllCells.Delete Shift:=xlShiftUp

End Sub

Answer 2

您的EmptyCells.Delete Shift:=xlShiftUp位于Do循环之外，因此在循环过程中不会执行它。如果您始终如一地缩进代码，则可以更轻松地发现这些类型的错误，例如：

Do Until EmptyCells Is Nothing
    Debug.Print EmptyCells.Address
    Set EmptyCells = Worksheets("Sheet1").Range("F30:W1000").FindNext(after=EmptyCells)
    If EmptyCells.Address = FirstAddr Then
        Exit Do
    End If
Loop
EmptyCells.Delete Shift:=xlShiftUp

将其格式化为一次显示.Delete不会发生在所有单元格中，但最后只发生一次。

Answer 3

如果Range（＆＃34; F30：W1000＆＃34;）中的所有单元格都包含值（在开头没有空白值），则以下代码将正常工作。

首先，替换范围内具有＆＃34; 0＆＃34;的所有单元格。在＃34;＆＃34;里面，所以现在它们实际上是空白的。

现在，使用SpecialCells(xlCellTypeBlanks)我们可以设置另一个范围，并立即删除所有范围。

注意：就像我在开头写的那样，只有当范围内的所有单元格都有值时才有效，如果有空单元格（PO表示没有单元格），它们将被删除太

<强>代码

Sub FindAllDelete()

Dim Rng As Range
Dim EmptyCells As Range

With Worksheets("Sheet1") '<-- modify "Sheet1" to your sheet's name
    Set Rng = .Range("F30:W1000")

    With Rng
        .Replace What:="0", Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False
    End With

    Set EmptyCells = Rng.SpecialCells(xlCellTypeBlanks)
    EmptyCells.Delete xlShiftUp
End With

End Sub

Answer 4

这可以在没有VBA的情况下完成，您可以使用 CTRL + H 用空格替换0，然后使用删除空格CTRL + G 选择空白并删除

带删除范围内的VBA FindAll方法

4 个答案: