讓我的腳本跨所有工作表運行（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