Excel VBA – 为什么这个macros删除一切

我需要这个macros的帮助。 我有一个格式很差的工作簿，但每次我打开它。 其中，目标是find列B中的非空白单元格，并删除下面的整个2行以及每个填充的B单元格上方的第1行。

我在代码中的第一个循环的工作方式就像我想要的那样，但是第二个循环似乎只在第一个填充的B单元实例上工作，但是它会删除其上的所有其他内容，比如500个单元的数据。

有人可以向我解释为什么会发生这种情况吗？如果你能find一种方法把这两个循环合并为一个，那也不错。

Sub test() Dim currentSht As Worksheet Dim startCell As Range Dim lastRow As Long, lastCol As Long Dim colNames As Variant Dim i As Integer, j As Integer Set currentSht = ActiveWorkbook.Sheets(1) Set startCell = currentSht.Range("A1") lastRow = startCell.SpecialCells(xlCellTypeLastCell).Row lastCol = startCell.SpecialCells(xlCellTypeLastCell).Column For i = lastRow To 1 Step -1 If currentSht.Cells(i, "B").Value <> "" Then currentSht.Cells(i, "B").Offset(1).EntireRow.Delete End If Next i Range("D3").Select Range(Selection, Selection.End(xlToRight)).Select Selection.Delete Shift:=xlUp currentSht.Rows("1:1").EntireRow.Delete currentSht.Range("c:d, f:g, i:k").EntireColumn.Delete currentSht.Range("A:D").Columns.AutoFit For j = lastRow To 2 Step -1 If currentSht.Cells(j, "B").Value <> "" Then currentSht.Range(Cells(j, "B").Offset(-1), Cells(j, "B").Offset(-3)).EntireRow.Delete End If Next j End Sub 

谢谢

Answer 1

第二个循环删除所有内容，因为删除了所find的值above的行，所述值被移动并且被再次find，触发另一个删除。 为了解决这个问题，最快的方法是通过修改j来跳过下面两行：

 For j = lastRow To 2 Step -1 If currentSht.Cells(j, "B").Value <> "" Then currentSht.Range(Cells(j, "B").Offset(-1), Cells(j, "B").Offset(-3)).EntireRow.Delete j = j - 2 End If Next j 

如果你从上到下循环，反之亦然，这并不重要。 唯一的区别是如果B列中有两个条目彼此靠近。 在这种情况下，search顺序将决定哪一个被删除。 但是，删除真的是你想要的？ 也许你可以。 .Clear行的内容，而不是删除它们。

编辑：这里的新代码有点清理

 Sub test() Dim currentSht As Worksheet Dim startCell As Range Dim lastRow As Long, lastCol As Long Dim colNames As Variant Dim i As Integer, j As Integer Set currentSht = ActiveWorkbook.Sheets(1) Set startCell = currentSht.Range("A1") lastRow = startCell.SpecialCells(xlCellTypeLastCell).Row lastCol = startCell.SpecialCells(xlCellTypeLastCell).Column For i = lastRow To 1 Step -1 If currentSht.Cells(i, "B").value <> "" Then 'reference the row directly currentSht.Rows(i + 1).Delete End If Next i 'Do not use selection if you can avoid it Range("D3", Range("D3").End(xlToRight)).Delete Shift:=xlUp currentSht.Rows(1).Delete currentSht.Range("C:D, F:G, I:K").Delete currentSht.Range("A:D").Columns.AutoFit For j = lastRow To 2 Step -1 If currentSht.Cells(j, "B").value <> "" Then currentSht.Rows(j - 1).Delete currentSht.Rows(j - 2).Delete j = j - 2 End If Next j End Sub 

如果你想组合循环，macros的行为将会因为在循环之间发生的删除而改变。