自动将新工作表名称添加到公式中的 AVERAGE 函数

Question

我有一个工作簿，用于跟踪项目的统计数据。我有一个附加到一个按钮的函数，它复制“模板”工作表并给它一个我输入的名称。

我在同一个工作簿中有一个名为“统计”的工作表，我在其中跟踪每个项目的所有工作表中某些单元格的总数和平均值。

将新工作表名称添加到仅将值相加的公式中没有问题。

但是，我不知道如何格式化将新工作表名称（和单元格名称）添加到 AVERAGE() 函数的内容。

这是目前为止的宏：

Sub btnAdd_Click()
    
    Dim strFormula As String
    
    strBookName = ""
    
    frmAddBook.Show
        
    If Len(strBookName) <> 0 Then
        'Add the sheet...
        ActiveWorkbook.Sheets("Template").Copy After:=Sheets(Sheets.Count)
        ActiveSheet.Name = strBookName
        ActiveSheet.Cells(1, 2) = strBookName
        ActiveSheet.Cells(1, 1).Activate
        
        'Modify the statisics totals to include those from the new sheet

        With Sheets("Statistics")

        'These are only adding to a formula which totals the cell values from each worksheet and this works

            .Cells(6, 4).Formula = .Cells(6, 4).Formula & " + " & Chr(39) & strBookName & Chr(39) & "!I4"
            .Cells(7, 4).Formula = .Cells(7, 4).Formula & " + " & Chr(39) & strBookName & Chr(39) & "!I3"
            .Cells(8, 4).Formula = .Cells(8, 4).Formula & " + " & Chr(39) & strBookName & Chr(39) & "!B5"
            .Cells(9, 4).Formula = .Cells(9, 4).Formula & " + " & Chr(39) & strBookName & Chr(39) & "!B4"
        
            .Cells(13, 4).Formula = .Cells(13, 4).Formula & " + " & Chr(39) & strBookName & Chr(39) & "!B7"

         'THESE ARE THE CELLS THAT I WANT TO USE THE AVERAGE FUNCTION AND APPEND WITH EACH NEW WORKSHEET NAME
        
            .Cells(5, 10).Formula = .Cells(5, 10).Formula & " + " & Chr(39) & strBookName & Chr(39) & "!L1"
            .Cells(6, 10).Formula = .Cells(6, 10).Formula & " + " & Chr(39) & strBookName & Chr(39) & "!L5"
            .Cells(7, 10).Formula = .Cells(7, 10).Formula & " + " & Chr(39) & strBookName & Chr(39) & "!L6"
       
        End With
        
    End If

End Sub

非常感谢任何帮助。谢谢！

Answer 1

使用“updateStats”方法从头开始构建公式可能更容易，使用工作簿中未命名为“模板”或“统计”的任何工作表：这样您还可以删除项目并刷新公式。

例如：在添加或删除工作表后调用它

Sub UpdateStats()
    
    Dim ws As Worksheet, nm, arrSkip, frm, sep
    
    arrSkip = Array("Template", "Statistics") 'add other sheet here
    
    frm = ""
    sep = ""
    For Each ws In ThisWorkbook.Worksheets
        nm = ws.Name
        'check name before processing
        If IsError(Application.Match(nm, arrSkip, 0)) Then
            frm = frm & sep & "'" & nm & "'!<C>"
            sep = ","
        End If
    Next ws
    With ThisWorkbook.Sheets("Statistics")
        If Len(frm) > 0 Then 'any sheets to summarize?
            .Cells(6, 4).Formula = "=SUM(" & Replace(frm, "<C>", "I4") & ")"
            .Cells(7, 4).Formula = "=SUM(" & Replace(frm, "<C>", "I3") & ")"
            .Cells(8, 4).Formula = "=SUM(" & Replace(frm, "<C>", "B5") & ")"
            .Cells(9, 4).Formula = "=SUM(" & Replace(frm, "<C>", "B4") & ")"
            .Cells(5, 10).Formula = "=AVERAGE(" & Replace(frm, "<C>", "L1") & ")"
            .Cells(6, 10).Formula = "=AVERAGE(" & Replace(frm, "<C>", "L5") & ")"
            .Cells(7, 10).Formula = "=AVERAGE(" & Replace(frm, "<C>", "L6") & ")"
        Else
            .Cells(6, 4).Resize(4, 1).Clear
            .Cells(5, 10).Resize(3, 1).Clear
        End If
    End With
End Sub