让我的脚本跨所有工作表运行（Excel）

Question

此代码适用于一张工作表，现在我试图让它在多张工作表上工作，避免前两张（“AA”和“Word频率”）。

原始代码here（见@ Jeeped的答案）

链接到工作表here

试图适应从相关的线程我发现（参考1，2）代码，但是我不知道如何（以及是否）将Ws.Name和Ws.Range对象应用到我现有的代码中。

好像代码激活工作表Sheet1使用With Worksheets("Sheet1")，我试着用下面的方法来取代这个：

1. 创建For循环功能byGroupCounter（）以确定有多少工作表也有，和运行所有现有的工作表。每个工作表将与可变

2. For循环中的“i” byGroupCounter递增（）上功能调用byGroup（ⅰ）运行所选的工作表上的原代码（即工作表“我” ）

3. 的byGroup（）函数运行它的整个工作表我过程。

4. 部分，我相信我得到一个错误：更换With Worksheets("Sheet1")代码With Ws，其中Ws = Worksheets(Sheet_Index)和Sheet_Index等于我，从byGroupCounter()

我相信定义我必须在.Range之前添加Ws前缀，但是我一直在尝试的所有内容，我总是收到错误“无法在分解模式下执行代码”。

目前代码：

Sub byGroupCounter() 

    Dim i As Integer 

    Application.ScreenUpdating = False 

For i = ActiveSheet.Index To Sheets.Count 
    byGroup i 
Next i 
Application.ScreenUpdating = True 
End Sub 

Sub byGroup(ByVal Sheets_Index As Integer) 
    Dim g As Long, s As Long, aSTRs As Variant, aGRPs As Variant 
    Dim Ws As Worksheet 
    Set Ws = Worksheets(Sheet_Index) 

appTGGL bTGGL:=False 

' I believe the next line is where I am doing something wrong: 
With Ws 
    aSTRs = .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp)).Value2 
    With .Range(.Cells(1, 5), .Cells(Rows.Count, 1).End(xlUp).Offset(0,  Application.Match("zzz", .Rows(1)) - 1)) 
     .Resize(.Rows.Count, .Columns.Count).Offset(1, 0).ClearContents 
     aGRPs = Ws.Cells.Value2 
    End With 

    For s = LBound(aSTRs, 1) To UBound(aSTRs, 1) 
     For g = LBound(aGRPs, 2) To UBound(aGRPs, 2) 
      If CBool(InStr(1, aSTRs(s, 1), aGRPs(1, g), vbTextCompare)) Then 
       aGRPs(s + 1, g) = aSTRs(s, 1) 
       Exit For 
      End If 
     Next g 
    Next s 

    .Cells(1, 5).Resize(UBound(aGRPs, 1), UBound(aGRPs, 2)) = aGRPs 

    End With 

    appTGGL 
End Sub 

Public Sub appTGGL(Optional bTGGL As Boolean = True) 
    Debug.Print Timer 
    Application.ScreenUpdating = bTGGL 
    Application.EnableEvents = bTGGL 
    Application.DisplayAlerts = bTGGL 
    Application.Calculation = IIf(bTGGL, xlCalculationAutomatic,  xlCalculationManual) 
End Sub 

Answer 1

只是有6隔着薄片改变原来的代码回路

我已经将它们与“< < <

Sub byGroup() 
    Dim g As Long, s As Long, aSTRs As Variant, aGRPs As Variant, sh As Worksheet '<<< 

    appTGGL bTGGL:=False 
    For Each sh In Sheets '<<< 
     If sh.Name <> "AA" And sh.Name <> "Word Frequency" Then '<<<< 
      With sh '<<< 
       aSTRs = .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp)).Value2 
       With .Range(.Cells(1, 5), .Cells(Rows.Count, 1).End(xlUp).Offset(0, Application.Match("zzz", .Rows(1)) - 1)) 
        .Resize(.Rows.Count, .Columns.Count).Offset(1, 0).ClearContents 
        aGRPs = .Cells.Value2 
       End With 

       For s = LBound(aSTRs, 1) To UBound(aSTRs, 1) 
        For g = LBound(aGRPs, 2) To UBound(aGRPs, 2) 
         If CBool(InStr(1, aSTRs(s, 1), aGRPs(1, g), vbTextCompare)) Then 
          aGRPs(s + 1, g) = aSTRs(s, 1) 
          Exit For 
         End If 
        Next g 
       Next s 

       .Cells(1, 5).Resize(UBound(aGRPs, 1), UBound(aGRPs, 2)) = aGRPs 

      End With 
     End If '<<<< 
    Next sh '<<< 
    appTGGL 
End Sub 

Public Sub appTGGL(Optional bTGGL As Boolean = True) 
    Debug.Print Timer 
    Application.ScreenUpdating = bTGGL 
    Application.EnableEvents = bTGGL 
    Application.DisplayAlerts = bTGGL 
    Application.Calculation = IIf(bTGGL, xlCalculationAutomatic, xlCalculationManual) 
End Sub