删除多个工作表上包含特定文本的所有行答案

【问题标题】：Removing all rows that contain specific text over multiple sheets删除多个工作表上包含特定文本的所有行
【发布时间】：2018-03-17 11:10:46
【问题描述】：

我有四张包含原始数据的工作表，我想将它们复制到我的工作簿中并单独留下以供交叉参考。然后我想删除带有文本“proj def”的单元格上方的所有行（它出现两次，但在两次出现之间有一些单元格 - 这在我的代码中很明显）。我想对我的工作簿的前四张执行此操作，同时保留原始重复的工作表，但只能使用标有“ptd”的第一个工作表来执行此操作。我试图激活下一个工作表“ytd”，甚至删除原始工作表“ptd”，看看它是否允许我更改 myRange 的位置，但我没有成功。基本上我想在子方法中运行这段代码，两个用于第一张表“ptd”，另外两个用于第二张表“ytd”，另外两个用于“qtr”，最后一个用于“mth”。对我的示例代码进行任何编辑将不胜感激。

Sub part1()
    Worksheets("ptd").Copy After:=Worksheets("mth")
    Worksheets("ytd").Copy After:=Worksheets("ptd (2)")
    Worksheets("qtr").Copy After:=Worksheets("ytd (2)")
    Worksheets("mth").Copy After:=Worksheets("qtr (2)")
End Sub
Sub part2()
Worksheets("ptd").Activate
Set rngActiveRange = ActiveCell
            Dim MyRange As Range
            Set MyRange = ActiveSheet.Range("A:A")
            MyRange.Find("Customer Unit", LookIn:=xlValues).Select
            rngActiveRange.Offset(-1, 0).Select
            Range(rngActiveRange.Row & ":" & 1).Rows.Delete
End Sub
Sub part3()
    Dim MyRange As Range
    Set MyRange = ActiveSheet.Range("A:A")
    MyRange.Find("Project Definition", LookIn:=xlValues).Select
    ActiveCell.Offset(-1, 0).Select
    Range(ActiveCell.Row & ":" & 1).Rows.Delete
End Sub
Sub part4()
Worksheets("ytd").Activate
Set rngActiveRange = ActiveCell
            Dim MyRange As Range
            Set MyRange = ActiveSheet.Range("A:A")
            MyRange.Find("Customer Unit", LookIn:=xlValues).Select
            rngActiveRange.Offset(-1, 0).Select
            Range(rngActiveRange.Row & ":" & 1).Rows.Delete
End Sub
Sub part5()
    Dim MyRange As Range
    Set MyRange = ActiveSheet.Range("A:A")
    MyRange.Find("Project Definition", LookIn:=xlValues).Select
    ActiveCell.Offset(-1, 0).Select
    Range(ActiveCell.Row & ":" & 1).Rows.Delete
End Sub

【问题讨论】：

激活每张工作表时的ActiveCell 是什么？是否要从下往上删除所有出现这些单词的行？
A26，“客户单元”的位置
如果“客户单位”在A26 和A199 中，是否要从1:198 中删除所有行？编辑：等等，你在两张纸上都有Customer Unit 和Project Definition。您想删除Customer Unit 之前的行，然后在删除Customer Unit 之前的行之后删除Project Definition 之前的行，是吗？我理解正确吗？
是的，这是正确的，这是我在项目定义第二次发生之前删除所有行的方法。我必须这样做，因为它出现在四个工作表的不同单元格位置。
等等 - 你想让它在 ytd、ptd、qtr 和 mth 上运行吗？

标签： vba excel loops range

【解决方案1】：

如果我理解正确，以下应该可以工作。我做的主要事情是用avoiding the use of .Select/.Activate 重写。

Sub remove_Rows()
Dim ws      As Worksheet
Dim foundCel As Range

' Copy sheets
Worksheets("ptd").Copy After:=Worksheets("mth")
Worksheets("ytd").Copy After:=Worksheets("ptd (2)")
Worksheets("qtr").Copy After:=Worksheets("ytd (2)")
Worksheets("mth").Copy After:=Worksheets("qtr (2)")

' Start removing rows
For Each ws In ActiveWorkbook.Worksheets
    With ws
        If InStr(1, .Name, "(") = 0 Then
            Set foundCel = .Range("A:A").Find("Customer Unit", LookIn:=xlValues)
            .Range(foundCel.Offset(-1, 0).Row & ":" & 1).Rows.Delete
            Set foundCel = .Range("A:A").Find("Project Definition", LookIn:=xlValues)
            .Range(foundCel.Offset(-1, 0).Row & ":" & 1).Rows.Delete
        End If
    End With
Next ws

End Sub

【讨论】：