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

可以通过工作表.CodeName property，工作表.Name property或Worksheet.Index property来识别工作表。

大量具有少量排除的工作表可能最适合使用基于索引的循环。

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

这两种方法在不同情况下运作良好。工作表代号最适合抽象地引用工作表;也许是从上述循环中复制/粘贴的目的地。

Answer 2

虽然不像其他方法那样优雅或动态，但您可以使用简单的For循环：

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

VBA Excel宏 - 如何为每张纸重复宏？

2 个答案: