Vba循环许多表

我有vba代码，增加了4张的计算。 我想要一个循环，将计算数百个工作表，而无需再次在代码中添加工作表名称。

Private Sub CommandButton2_Click() Dim TabNames As Variant, Ordinals As Variant TabNames = Array("4-16 - 4-22", "4-23 - 4-29", "4-30 - 5-6") Ordinals = Array("1st", "2nd", "3rd") For i = 0 To UBound(TabNames, 1) Range("A5").Offset(i).Value = TabNames(i) Range("B5").Offset(i).Value = Ordinals(i) Range("I5").Offset(i).Formula = "=AVERAGE('" & "adt" & TabNames(i) & "'!$P:$P)" Range("J5").Offset(i).Formula = "=COUNTIFS('" & "adt" & TabNames(i) & "'!$P:$P,"">=""&1)" Range("C5").Offset(i).Formula = "=AVERAGEIFS('" & "adt" & TabNames(i) & "'!$P:$P, '" & "adt" & TabNames(i) & "'!$P:$P, "">301"",'" & "adt" & TabNames(i) & "'!$P:$P, ""<480"")" Range("D5").Offset(i).Formula = "=COUNTIFS('" & "adt" & TabNames(i) & "'!$P:$P,"">""&301,'" & "adt" & TabNames(i) & "'!$P:$P,""<""&480)" Range("F5").Offset(i).Formula = "=AVERAGEIFS('" & "adt" & TabNames(i) & "'!$P:$P, '" & "adt" & TabNames(i) & "'!$P:$P, "">=1"",'" & "adt" & TabNames(i) & "'!$P:$P, ""<300"")" Range("G5").Offset(i).Formula = "=COUNTIFS('" & "adt" & TabNames(i) & "'!$P:$P,"">=""&1,'" & "adt" & TabNames(i) & "'!$P:$P,""<""&300)" Next Range("E5:E7,H5:H7,K5:K7").FormulaR1C1 = "=(R2C3-R[0]C[-2])*(R1C4*R[0]C[-1])" End Sub 

感谢您的帮助。

Answer 1

首先 ，创build一个例程，使用参数为一个工作表创build所需的内容：

 Private Sub AddTableFormulas(ByVal sName As String, ByVal nOffset As Long) With Sheets("NameOfTotalsSheet") .Range("A5").Offset(nOffset).Value = sName .Range("B5").Offset(nOffset).Value = getOrdinal(nOffset + 1) .Range("I5").Offset(nOffset).Formula = "=AVERAGE('" & "adt" & sName & "'!$P:$P)" 'etc End With End Sub Private Function getOrdinal(ByVal nNumber As Long) As String Dim sNumber As String sNumber = nNumber Select Case Right(sNumber,1) Case "1" getOrdinal = nNumber & "st" Case "2" getOrdinal = nNumber & "nd" Case "3" getOrdinal = nNumber & "rd" Case Else getOrdinal = nNumber & "th" End Select End Function 

其次 ，编写一个适合所有符合条件的表格的例程：

 Public Sub AddAllFormulas() Dim oSheet As Excel.Worksheet Dim sName As String Dim nOffset As Long For Each oSheet In Worksheets If Left(oSheet.Name, 3) = "adt" Then sName = Right(oSheet.Name, Len(oSheet.Name) - 3) AddTableFormulas sName, nOffset nOffset = nOffset + 1 End If Next 'oSheet 'add final calculations here. use offset to determine location End Sub 

最后 ，从你的button调用这个例程：

 Private Sub CommandButton2_Click() AddAllFormulas End Sub