Excel 删除所有工作表中包含特定单词的所有列

我试图修改下面的宏（在互联网上的其他地方），使其适用于Excel文件中的所有工作表。然而，它并没有像预期的那样工作。我如何使它工作

Sub Col_Delete_by_Word_2()
    Dim Found As Range, strWord As String, Counter As Long
    Dim CurrentSheet As Object
    Dim ws As Worksheet

    strWord = Application.InputBox("Enter the word to search for.", _
    "Delete the columns with this word", Type:=2)

    If strWord = "False" Or strWord = "" Then Exit Sub 'User canceled

    Set Found = Cells.Find(strWord, , , xlPart, , xlNext, False)

    For Each ws In ActiveWorkbook.Worksheets
        If Not Found Is Nothing Then
            Application.ScreenUpdating = False
            Do
                Found.EntireColumn.Delete
                Counter = Counter + 1
                Set Found = Cells.Find(strWord, , , xlPart, , xlNext, False)
            Loop Until Found Is Nothing
            Application.ScreenUpdating = True

            MsgBox Counter & " columns deleted.", vbInformation, "Process Complete"

        Else
            MsgBox "No match found for: " & strWord, vbInformation, "No Match"
        End If
    Next
End Sub

---

问题是您没有在循环中搜索单词。此外，如果删除循环中的列，代码将变慢。将其存储在rage变量中，然后在搜索该工作表后一次性删除

另外，当您设置

应用程序
事件时，请使用错误处理，以便在代码中断时，可以将其设置回默认值。另一个好方法是在宏运行之前将计算设置为手动

这就是你正在尝试的（尝试和测试的）吗？我已经对代码进行了注释，所以您在理解代码时不会有任何问题。但是，如果您这样做了，只需回发：）

这个词可以出现在工作表的任何地方，也可以只出现在第1行中？问题是，它不能循环到excel中的其他工作表，因为一开始没有说清楚，我的英语不太好：（Hi@SiddharthRout，当我打开两个excel文件时，其中一个包含此宏，另一个不包含此宏，当我在没有宏的excel窗口中单击宏时，它将应用回有宏的excel，但不是当前没有宏的excel，是否有办法解决此问题？？如果我试图从“ActiveWorkbook”调用宏，但请记住，当第一个工作簿处于活动状态时，不应调用宏。或者，您可以从第一个工作簿打开第二个工作簿，然后运行该宏。在这种情况下，您必须使用
Set wb=workbooks.open（）
然后用
wb
Option Explicit

Sub Col_Delete_by_Word_2()
    Dim ws As Worksheet
    Dim aCell As Range, bCell As Range, delRange As Range
    Dim strWord As Variant
    Dim appCalc As Long

    On Error GoTo Whoa

    '~~> Set the events off so that macro becomes faste
    With Application
        .ScreenUpdating = False
        appCalc = .Calculation
        .Calculation = xlCalculationManual
    End With

    '~~> Take the input from user
    strWord = Application.InputBox("Enter the word to search for.", _
    "Delete the columns with this word", Type:=2)

    '~~> Check if user pressed cancel orr is it a blank input
    If strWord = "False" Or strWord = "" Then Exit Sub

    '~~> Loop theough the worksheets
    For Each ws In ThisWorkbook.Worksheets
        With ws.Cells
            '~~> Find the search text
            Set aCell = .Find(What:=strWord, LookIn:=xlValues, _
                        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                        MatchCase:=False, SearchFormat:=False)
            '~~> If FOund
            If Not aCell Is Nothing Then
                Set bCell = aCell
                '~~> Instead of deleting the column in a loop
                '~~> We will store it in a range so that we can
                '~~> delete it later
                Set delRange = aCell

                '~~> Find Next
                Do
                    Set aCell = .FindNext(After:=aCell)

                    If Not aCell Is Nothing Then
                        If aCell.Address = bCell.Address Then Exit Do
                        Set delRange = Union(delRange, aCell)
                    Else
                        Exit Do
                    End If
                Loop
            End If

            '~~> Delete the columns in one go
            If Not delRange Is Nothing Then _
            delRange.EntireColumn.Delete Shift:=xlToLeft
        End With
    Next
LetsContinue:
    '~~> Reset events
    With Application
        .ScreenUpdating = True
        .Calculation = appCalc
    End With
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub