VBA Excelmacros – 如何重复每个工作表的macros？
我已经拼凑出了这个完美的macrosVBA。 但是，我需要在同一工作簿中的多个工作表上运行相同的代码。 我已经尝试了很多我在网上看到的东西（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 工作表可以通过其Worksheet .CodeName属性 ，Worksheet .Name属性或Worksheet.Index属性等来标识。
大量排除less量的工作表可能是最好的基于索引的循环。
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（s）放入数组中。
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
这两种方法在不同的情况下运作良好。 工作表代号最好是抽象地引用工作表。 也许作为从上述循环中复制/粘贴的目的地。
虽然不像其他方法那样优雅或dynamic，但可以使用简单的For循环：
For iCount = 1 to 99 'number of Worksheets Worksheets(iCount).select 'Insert your code here Next