VBA FindAll方法在范围内删除

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

在我的代码中有一个无限循环的问题。 我相信这个问题可能与LastCell有关。

我需要find一个范围内的所有0。 select，删除和移动单元格。

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循环之外，因此在循环单元期间不会执行该循环。 如果您始终缩进代码，则发现这些types的错误会变得更加容易，例如：

 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

如果范围（“F30：W1000”）中的所有单元格都有值（开头没有空白值），则以下代码将正常工作。

首先用“”replace范围内有“0”的所有单元格，现在它们实际上是空白的。

现在，使用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 + Hreplace空白的0，然后使用CTRL + Gselect空白和删除空白