Excel VBA基于单元格删除行

时间:2017-03-14 02:00:48

标签: excel vba excel-vba

我有这个代码,我想循环遍历所有工作表并根据值&#34完成删除整行#34;已完成"位于工作表中的任何位置......这只能在活动工作表上运行,我无法想出让它循环完成每张工作表的好方法......任何帮助都非常感谢! TY

Private Sub TestDeleteRows()
Dim rFind As Range
Dim rDelete As Range
Dim strSearch As String
Dim sFirstAddress As String

strSearch = "Completed"
Set rDelete = Nothing

Application.ScreenUpdating = False

With Sheet1.Columns("A:AO")
Set rFind = .Find(strSearch, 
LookIn:=xlValues, LookAt:=xlPart,   SearchDirection:=xlNext, MatchCase:=False)
If Not rFind Is Nothing Then
    sFirstAddress = rFind.Address
    Do
        If rDelete Is Nothing Then
            Set rDelete = rFind
        Else
            Set rDelete = Application.Union(rDelete, rFind)
        End If
        Set rFind = .FindNext(rFind)
    Loop While Not rFind Is Nothing And rFind.Address <> sFirstAddress

    rDelete.EntireRow.Delete

End If
End With
Application.ScreenUpdating = False
End Sub

1 个答案:

答案 0 :(得分:1)

Private Sub TestDeleteRows()
Dim rFind As Range
Dim rDelete As Range
Dim strSearch As String
Dim sFirstAddress As String
Dim sh As Worksheet

strSearch = "Completed"
Set rDelete = Nothing

Application.ScreenUpdating = False
For Each sh In ThisWorkbook.Sheets
With sh.Columns("A:AO")
Set rFind = .Find(strSearch, LookIn:=xlValues, LookAt:=xlPart, SearchDirection:=xlNext, MatchCase:=False)
If Not rFind Is Nothing Then
    sFirstAddress = rFind.Address
    Do
        If rDelete Is Nothing Then
            Set rDelete = rFind
        Else
            Set rDelete = Application.Union(rDelete, rFind)
        End If
        Set rFind = .FindNext(rFind)
    Loop While Not rFind Is Nothing And rFind.Address <> sFirstAddress

    rDelete.EntireRow.Delete
    Set rDelete = Nothing
End If
End With
Next sh
Application.ScreenUpdating = False
End Sub