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 代码是什么?
类似于:
- select全部
- 确定两个空白行的位置并删除其中一行
提前致谢!
为了改进问题并用我自己的 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
...
我的工作sheet 包含我想保留的空白行。
但是它也包含两个空白行的组,我想保留其中一个,但 delete/remove 另一个。
最终结果:sheet 仅包含单个空白行。
第一个附件显示之前(突出显示两个空白行),第二个附件显示所需的最终结果(作品sheet 仅包含单个空白行)。
请问实现这个的 VBA 代码是什么?
类似于:
- select全部
- 确定两个空白行的位置并删除其中一行
提前致谢!
为了改进问题并用我自己的 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
...