VBA Excel宏-如何為每個工作表重復該宏？

Question

我把這個宏VBA拼湊得很完美。 但是，我需要在同一工作簿中的多個工作表上運行相同的代碼。 我已經嘗試了很多我在網上看到的東西（SubWorksheetLoop2等），但沒有運氣。 我們的目標是在下面使用此代碼，並使其遍歷工作簿的所有頁面。 我的標簽頁名稱為“ CLASS II”，“ CLASS III”等。請告知！

Option Explicit
Sub InsertBetweenV3()
Dim Area As Range
Dim r As Long, lr As Long, sr As Long, er As Long, i
enter code here
'  turn off screen updating
Application.ScreenUpdating = False
enter code here
'  create an array to fill the 6 inserted rows
i = Array("", "OBS", "VIOL", "VIOL RATE", "STATEMENT", "")
enter code here
enter code here
'  activate/select the first worksheet
Worksheets(1).Activate
enter code here
'  lr is for last row.  Find the last row in column 1 = column A
lr = Cells(Rows.Count, 1).End(xlUp).Row
'  when we are inserting/deleting rows we usually start from the bottom up
For r = lr To 3 Step -1
'  Range("A" & r) is not equal to Range("A" & r - 1)
' If A1535 is not equal to A1534 Then
  If Cells(r, 1) <> Cells(r - 1, 1) Then
' insert 6 rows
 Rows(r).Resize(6).Insert
  End If
Next r

' now that we have inserted six empty rows for each change in STATION
' find the new last row in column 1 = column A
lr = Cells(Rows.Count, 1).End(xlUp).Row
' for each Area in range A1:A new last row
' Area will find each group of rows between the inserted 6 rows
For Each Area In Range("A2", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants).Areas
' with each Area
With Area
'  sr a variable for start row
'  the .Row of the Area is the first row of the Area sr = .Row
  sr = .Row
' er a variable for end row
 ' is equal to sr + count of rows in the Area – 1
 ' er = sr + .Rows.Count – 1

    er = sr + .Rows.Count - 1

' beginning in the blank inserted 6 rows
 ' transpose the i array vertically
    Cells(er + 1, 1).Resize(6).Value = Application.Transpose(i)
' in the first blank row change the interior color to Gray
'  from column 1 = column A to column 46 = column AT
    Cells(er + 1, 1).Resize(, 68).Interior.ColorIndex = 15
' bold the text inserted from the i array
    Cells(er + 2, 1).Resize(4).Font.Bold = True
  ' in the last blank row change the interior color to Gray
  '   from column 1 = column A to column 46 = column AT
    Cells(er + 6, 1).Resize(, 68).Interior.ColorIndex = 15
    ' put the formula in the appropriate cells to do the calculations
Range("G" & er + 2).Formula = "=COUNTIF(G" & sr & ":G" & er & ","">0"")"
Range("G" & er + 3).Formula = "=SUM(COUNTIF(G" & sr & ":G" & er & ", ""<6""),COUNTIF(G" & sr & ":G" & er & ","">9""),-COUNTIF(G" & sr & ":G" & er & ",""=0""))"
Range("G" & er + 4).Formula = "=(G" & er + 3 & "/G" & er + 2 & ")*100"
Range("K" & er + 2).Formula = "=COUNTIF(K" & sr & ":K" & er & ","">0"")"
Range("K" & er + 3).Formula = "=COUNTIF(K" & sr & ":K" & er & ","">32"")
Range("K" & er + 4).Formula = "=(K" & er + 3 & "/K" & er + 2 & ")*100"
Range("I" & er + 2).Formula = "=COUNTIF(I" & sr & ":I" & er & ","">0"")"
Range("I" & er + 3).Formula = "=SUM(COUNTIF(I" & sr & ":I" & er & ",""<4""),-COUNTIF(I" & sr & ":I" & er & ",""=0""))"
Range("I" & er + 4).Formula = "=(I" & er + 3 & "/I" & er + 2 & ")*100"
Range("S" & er + 2).Formula = "=COUNTIF(S" & sr & ": S" & er & ","">0"")"
Range("S" & er + 3).Formula = "=COUNTIF(S" & sr & ": S" & er & ","">235"")"
Range("S" & er + 4).Formula = "=(S" & er + 3 & "/ S" & er + 2 & ")*100"
Range("U" & er + 2).Formula = "=COUNTIF(U" & sr & ":U" & er & ","">0"")"
Range("U" & er + 3).Formula = "=COUNTIF(U" & sr & ":U" & er & ","">104"")"
Range("U" & er + 4).Formula = "=(U" & er + 3 & "/U" & er + 2 & ")*100"
  End With
Next Area
' find the last row in column 1 = column A
lr = Cells(Rows.Count, 1).End(xlUp).Row
' in the following ranges change the number format
Range("G2:G" & lr).NumberFormat = "0.000"
Range("K2:K" & lr).NumberFormat = "0.000"
Range("S2:S" & lr).NumberFormat = "0.000"
Range("U2:U" & lr).NumberFormat = "0.000"
' turn back on screen updating
Application.ScreenUpdating = True
End Sub

Answer 1

可以通過其Worksheet .CodeName屬性 ，Worksheet .Name屬性或Worksheet.Index屬性來標識工作表 。

最好使用基於索引的循環來查找大量工作表，其中包含少量排除項。

dim w as long
for w = 1 to worksheets.count
    with worksheets(w)
        if .name <> "Master" and .name <> "Summary" then
            'do some stuff with the worksheet(s)
        end if
    end with
next w

如果特定工作表的數量有限，則可以將.name放入數組中。

dim v as long, vWSs as variant
vWSs = array("CLASS II", "CLASS III", "CLASS IV")
for v = lbound(vWSs) to ubound(vWSs)
    with worksheets(vWSs(v))
        'do some stuff with the worksheet(s)
    end with
next v

這是兩種在不同情況下均能很好工作的方法。 工作表代號最適合抽象地引用工作表。 可能是從上述循環之一中復制/粘貼的目的地。

Answer 2

雖然不像其他方法那樣優雅或動態，但是您可以使用簡單的For循環：

For iCount = 1 to 99 'number of Worksheets 
Worksheets(iCount).select
'Insert your code here
Next