在所有excel表格上运行脚本。

I have this script that searches for a defined string and deletes the column if it finds it. I want to run this same search across all sheets in the workbook. So far I have tried setting it up like this. But it will only run on the Active Sheet.

我有这个脚本，它搜索一个已定义的字符串，如果它找到它，就删除这个列。我想对工作簿中的所有表执行相同的搜索。到目前为止，我尝试过这样设置。但它只会在活动页面上运行。

Sub RunMacroOnAllSheetsToRight()
For i = ActiveSheet.Index To Sheets.Count
    Call MyFunction(i)
Next i
End Sub


Function MyFunction(i)
Dim c As Range
            Dim str As String

            str = "SearchStringHere"

            For Each c In ActiveSheet.UsedRange
               If InStr(c.Value, str) > 0 Then
               c.EntireColumn.Delete Shift:=xlToLeft
               End If
            Next c

End Function

Script now cycles through but only deletes single columns for some reason. Needs to be able to match and delete multiple columns per sheet.

脚本现在循环执行，但出于某种原因只删除单个列。需要能够匹配和删除每个表的多个列。

1 个解决方案

#1

You just need to change ActiveSheet in your "function" and it'll be better!

你只需要在你的“函数”中修改ActiveSheet，它就会更好!

BTW : You can have a Sub with paramaters (as below) and a function is only necessary when you have an output result (that you don't have in your example).

顺便说一下，你可以有一个辅助参数(如下所示)，当你有一个输出结果(在你的例子中你没有)时，一个函数是唯一必要的。

2 main changes : - added Set Ws=Nothing to free Ws - changed incremental going through columns, because when delete a column going increasingly, you miss to analyse next column(j+1)which is now the column(j)

2个主要变化:-添加Set Ws= no来释放Ws -通过列进行增量更改，因为当删除一个列越来越频繁时，您会错过分析下一列(j+1)，即现在的列(j)

Sub RunMacroOnAllSheetsToRight()
Application.ScreenUpdating = False
For i = ActiveSheet.Index To Sheets.Count
    Column_Delete i, "SearchStringHere"
Next i
Application.ScreenUpdating = True
End Sub


Sub Column_Delete(ByVal Sheets_Index As Integer, ByVal Str_to_Find As String)

Dim Ws As Worksheet
Set Ws = Worksheets(Sheets_Index)


Dim EndColumn As Integer
EndColumn = Ws.Cells(1, Columns.Count).End(xlToLeft).Column

'descending travel of the columns as we are going to delete some of them
For j = 1 To EndColumn
    If InStr(Ws.Cells(1, EndColumn - j + 1), Str_to_Find) > 0 Then
        Ws.Columns(EndColumn - j + 1).EntireColumn.Delete Shift:=xlToLeft
    End If
Next j

'Don't forget to free Ws (like I did...)
Set Ws = Nothing

End Sub

#1