VBA循环多张 [英] Vba loop for many sheets

问题描述

我有vba代码增加了4张计算。我想要一个循环，将计算数百张，而不再添加sheetname&再次在代码中。

  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，第二个，第三）
 
对于i = 0到UBound（TabNames，1）
范围（A5）。偏移（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）
范围（C5）偏移（i）.Formula == AVERAGEIFS（' ;adt&，$，，，，$，& ，&adt&昵称（i）&！$ P：$ P，< 480）
范围（D5）。 ）.Formula == COUNTIFS（'&adt&TabNames（i）&'！$ P：$ P，>& &安培; ADT &安培; TabNames（I）及$！$$$$$$$$$$$ ; TabNames（i）&'！$ P：$ P，'&adt&TabNames（i）&'！$ P：$ P，> = 1 &adt&ad $$$$$$$$$（G5）偏移（i）.Formula = = COUNTIFS（'&adt&昵称（i）&'！$ P：$ P，> =& 1，'&adt& （E5：E7，H5：H7，K5：K7），
下一个
范围（E5：E7，H5：H7，K5：K7）。公式R1C1 ==（R2C3-R [0] C [-2]）*（R1C4 * R [0] C [-1]）
 End Sub 
  / pre> 
 
 
感谢您的帮助。
解决方案
 首先，创建一个例程，使用参数执行一个Sheet的所需操作：
  Private Sub AddTableFormulas（ByVal sName As String，ByVal nOffset As Long）
 With Sheets（NameOfTotalsSheet）
 .Range（A5）。Offset（nOffset）.Value = sName 
 .Range（B5）。偏移（nOffset）.Value = getOrdinal（nOffset + 1）
 .Range（I5）。Offset（nOffset）.Formula == AVERAGE（'& adt& sName& $！pre $
 
'etc 
 
结束
 End Sub 
 
私有函数getOrdinal（ByVal nNumber As Long）As String 
 Dim sNumber As String 
 
 sNumber = nNumber 
选择案例权限（sNumber，1）
案例1
 getOrdinal =数字& st
案例2
 getOrdinal = nNumber& nd
 Case3
 getOrdinal = nNumber& rd
 Case Else 
 getOrdinal = nNumber& th
结束选择
 
结束功能
  
 第二个，写一个例行程序，为所有符合条件的表格：
  Public Sub AddAllFormulas（） 
 Dim oSheet As Excel.Worksheet 
 Dim sName As String 
 Dim nOffset As Long 
 
工作表中的每个oSheet 
如果剩下（oSheet.Name， 3）=adt然后
 sName = Right（oSheet.Name，Len（oSheet.Name） -  3）
 AddTableFormulas sName，nOffset 
 nOffset = nOffset + 1 
结束如果
下一步'oSheet 
 
'在这里添加最终计算。使用偏移来确定位置
 
 End Sub 
  
  strong>，从您的按钮中调用此例程：
  Private Sub CommandButton2_Click（）
 AddAllFormulas 
 End Sub 
  
 
I have vba code that adds calculations for 4 sheets. I want a loop that will calculate hundreds of sheet without adding sheetname again & again in code. 
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
Thank you for your help.
解决方案
First, create a routine that does what you want for one Sheet using parameters:
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
Second, write a routine that does it for all Sheets that match your criteria:
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
Finally, call this routine from your button:
Private Sub CommandButton2_Click()
    AddAllFormulas
End Sub


                        
这篇关于VBA循环多张的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！