下面这段宏代码,运行后会弹出对话框,然后输入内容,即可批量删除内容所在的行。
Sub 删除特定字符所在行() Dim rng As Range 'On Error Resume Next istr = InputBox("请输入需要查找的字符:", "查找") If istr = "" Then Exit Sub arr = Split(istr, "、") With ActiveSheet For j = 0 To UBound(arr) For i = 1 To .UsedRange.Row + .UsedRange.Rows.Count - 1 Set icol = .Rows(i).Find(arr(j), LookAt:=xlPart) If Not icol Is Nothing Then k = k + 1 If rng Is Nothing Then Set rng = .Rows(i) Else Set rng = Union(rng, .Rows(i)) End If End If Next i Next j If k = 0 Then MsgBox "没有发现含有" & istr & "的行." ElseIf MsgBox("共发现了" & k & "个含有" & istr & "的行,是否删除这些行?", vbYesNo) = vbYes Then rng.Delete End If End With End Sub
另一段宏代码是反向删除行,填入要保留的字符,运行后可将字符所在行以为的行批量删除:
Sub 删除特定字符所在行以外的行() Dim rng As Range istr = InputBox("请输入需要查找的字符:", "查找") If istr = "" Then Exit Sub arr = Split(istr, "、") With ActiveSheet For i = 1 To .UsedRange.Row + .UsedRange.Rows.Count - 1 k = 0 For j = 0 To UBound(arr) Set icol = .Rows(i).Find(arr(j), LookAt:=xlPart) If Not icol Is Nothing Then k = k + 1 Next j If k = 0 Then If rng Is Nothing Then Set rng = .Rows(i) Else Set rng = Union(rng, .Rows(i)) End If End If Next i If MsgBox("是否保留含有" & istr & "的行,删除其它行?", vbYesNo) = vbYes Then rng.Delete End If End With End Sub
发表回复