Question

我有vba代码，可以为4张纸添加计算。我想要一个循环，它将计算数百张纸而不再添加sheetname＆amp;再次在代码中。

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

首先，创建一个例程，使用参数为一张工作表执行所需的操作：

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

最后，请从按钮调用此例程：

Private Sub CommandButton2_Click()
    AddAllFormulas
End Sub

很多床单的Vba循环

1 个答案: