tra*_*cer 3 excel vba excel-vba delete-row
我一直在尝试使用一些片段来说明如何删除Excel VBA上的整行,但我无法修改它们以包含"IsNumber"验证.
我需要能够选择一个活动区域,例如:
Set r = ActiveSheet.Range("A1:C10")
Run Code Online (Sandbox Code Playgroud)
并且当它经过一行一行(并检查该区域的每个单元格)时,如果单元格上有数字,则删除整行.
例如:
NA NA NA 21
NA 22 NA 44
00 NA NA NA
NA NA NA NA
55 NA NA NA
Run Code Online (Sandbox Code Playgroud)
然后宏将删除所有行,除了第4行
NA NA NA NA
Run Code Online (Sandbox Code Playgroud)
拿你的选择:)
方式1(经过试验和测试)
这用于SpecialCells标识具有数字的行.
Sub Sample()
Dim ws As Worksheet
Dim rng As Range
On Error GoTo Whoa
Set ws = Sheets("Sheet1")
With ws
Set rng = .Cells.SpecialCells(xlCellTypeConstants, xlNumbers).EntireRow
rng.ClearContents '<~~ or rng.Clear if cells have formatting
.Cells.Sort Key1:=.Range("A1")
End With
Exit Sub
Whoa:
MsgBox Err.Description
End Sub
Run Code Online (Sandbox Code Playgroud)
方式2(经过试验和测试)
这使用循环并Count()检查数字
Sub Sample()
Dim ws As Worksheet
Dim delrange As Range
Dim lRow As Long, i As Long
On Error GoTo Whoa
Set ws = Sheets("Sheet1")
With ws
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
For i = 1 To lRow
If Application.WorksheetFunction.Count(.Rows(i)) > 0 Then
If delrange Is Nothing Then
Set delrange = .Rows(i)
Else
Set delrange = Union(delrange, .Rows(i))
End If
End If
Next i
If Not delrange Is Nothing Then delrange.Delete
End With
Exit Sub
Whoa:
MsgBox Err.Description
End Sub
Run Code Online (Sandbox Code Playgroud)
方式3(经过试验和测试)
这使用自动过滤器.我假设第1行有标题,你的范围内没有空白单元格.
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long, lCol As Long, i As Long
Dim ColN As String
On Error GoTo Whoa
Set ws = Sheets("Sheet1")
With ws
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
For i = 1 To lCol
'~~> Remove any filters
.AutoFilterMode = False
ColN = Split(.Cells(, i).Address, "$")(1)
'~~> Filter, offset(to exclude headers) and delete visible rows
With .Range(ColN & "1:" & ColN & lRow)
.AutoFilter Field:=1, Criteria1:=">=" & _
Application.WorksheetFunction.Min(ws.Columns(i)), _
Operator:=xlOr, Criteria2:="<=" & _
Application.WorksheetFunction.Max(ws.Columns(i))
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
'~~> Remove any filters
.AutoFilterMode = False
Next
End With
Exit Sub
Whoa:
MsgBox Err.Description
End Sub
Run Code Online (Sandbox Code Playgroud)
| 归档时间: |
|
| 查看次数: |
7805 次 |
| 最近记录: |