Excel VBA 如何找到出现两个空白行的位置并删除其中一行?

Excel VBA how can I find where two blank rows appear and delete one of those rows?

我的工作sheet 包含我想保留的空白行。

但是它也包含两个空白行的组,我想保留其中一个,但 delete/remove 另一个。

最终结果:sheet 仅包含单个空白行。

第一个附件显示之前(突出显示两个空白行),第二个附件显示所需的最终结果(作品sheet 仅包含单个空白行)。

请问实现这个的 VBA 代码是什么?

类似于:

  1. select全部
  2. 确定两个空白行的位置并删除其中一行

提前致谢!


为了改进问题并用我自己的 VBA 代码展示我的努力....这就是我从变量计数器 0 开始的结果,当它达到 2 时它会删除一行,它的工作原理与查找和删除所需的行一样,但它似乎 运行 一个无限循环:(

Sub EmptyRows()

Dim x As Integer
Dim row As Integer


  NumRows = ActiveSheet.UsedRange.Rows.Count
  ' Select cell A2.
  Range("A2").Select
  row = 0
  ' Establish "For" loop to loop "numrows" number of times.
  For x = 1 To NumRows
  
    
     If Application.CountA(ActiveCell.EntireRow) = 0 Then
        row = row + 1
     End If
     ActiveCell.Offset(1, 0).Select
     If Application.CountA(ActiveCell.EntireRow) = 0 Then
        row = row + 1
     End If
     
     If row >= 2 Then
        MsgBox "2 Rows!"
        ActiveCell.EntireRow.Delete
        
     End If
     
     ' Selects cell down 1 row from active cell.
     ActiveCell.Offset(1, 0).Select
     row = 0
  Next

 End Sub

请尝试下一个代码。它将检查整个分析的行是否真的为空:

Sub deleteSecondBlankRow()
  Dim sh As Worksheet, arr, rngDel As Range, lastR As Long, i As Long
  
  Set sh = ActiveSheet
  lastR = sh.Range("A" & sh.rows.Count).End(xlUp).row
  arr = sh.Range("A2:A" & lastR).value
  For i = 1 To UBound(arr)
        If arr(i, 1) = "" Then
            If WorksheetFunction.CountA(rows(i + 1)) = 0 Then
                If arr(i + 1, 1) = "" Then
                    If WorksheetFunction.CountA(rows(i + 2)) = 0 Then
                        If rngDel Is Nothing Then
                            Set rngDel = sh.Range("A" & i + 2)
                        Else
                            Set rngDel = Union(rngDel, sh.Range("A" & i + 2))
                        End If
                    End If
                End If
            End If
        End If
  Next i
  If Not rngDel Is Nothing Then rngDel.EntireRow.Select
End Sub

代码只选择要删除的行。如果您检查它并且选择方便,您应该只在最后一行代码中将 Select 替换为 Delete...