创建公式，相同单元格，动态张数答案

【问题标题】：Creating a formula, Same cell, Dynamic number of sheets创建公式，相同单元格，动态张数
【发布时间】：2017-09-15 03:52:51
【问题描述】：

我创建了一个工作簿，其中包含 2 张将始终存在的工作表：“Master”和“Score”。在主表上，我有一个命名的动态范围，我将在其中输入名称，例如（Mike、Sheila、Tom 和 Matt）我有一个宏，它将采用该名称列表并创建单独的表。此列表可以从 3 到 20 不等。

Sub create_ws()

    Dim MyCell As Range, MyRange As Range
    Dim NewName As String

    Set wb1 = ThisWorkbook
    Set ws2 = wb1.Sheets("Master")


    'This Macro will create separate tabs based on a list in Master Tab K2 down

    Set MyRange = ws2.Range("K2")
    Set MyRange = Range(MyRange, MyRange.End(xlDown))

    screen 0, 1

    For Each MyCell In MyRange
        If SheetExists(MyCell) Then
            NewName = InputBox("Sheet already exists, Please specify a unique name!", "New Copy")
                If NewName = vbNullString Or NewName = "" Then
                    screen 1
                    Exit Sub
                End If

            Sheets.Add after:=Sheets(Sheets.Count)
            Sheets(Sheets.Count).Name = (NewName)
        Else
            Sheets.Add after:=Sheets(Sheets.Count) 'creates a new worksheet
            Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet
            format_tabs (MyCell) 'calls next process to add named tabs
        End If
    Next MyCell

    screen 1

    ws2.Select
End Sub

在每张纸上，格式都是相同的：A 列和 B 列预先填写了数据，然后 C、D 和 E 列是人们填写评分信息的地方。工作表和行会有所不同，但需要平均的列总是相同的。

我要做的是在“评分”表上开发一个宏，该宏将构建一个公式，该公式将平均每个表中的响应而不是静态名称，并将它们放入评分表上的正确单元格中。例如，如果有 11 个问题，则公式将放在 C2, D2, E2, C3, D3, E3...一直到 C12, D12, E12。在评分表上的cell C2 中，公式应为=AVERAGE(Mike!C2,Sheila!C2,Tom!C2,Matt!C2)，在cell D2 中，公式应为=AVERAGE(Mike!D2,Sheila!D2,Tom!D2,Matt!D2)

我的命名范围是GReviewers，从Master!K2 开始。我目前有辅助单元，但我希望完全自动化工作簿以及扩展我的 VBA 知识。

这是我最初找到的一些代码。它总结了我需要它的所有工作表并将其放入我需要它进入的单元格中，但我需要它来平均它，如果我可以让公式显示在单元格中，我将能够使用.FillDown .

Sub Totals()

Dim c As Range, mytotal As Double

mytotal = 0

    For Each c In Range("GReview")
        mytotal = mytotal + Sheets(c.Value).Range("C2")
    Next c
        ThisWorkbook.Worksheets("Score").Range("C2") = mytotal

End Sub

【问题讨论】：

请提供您迄今为止尝试过的任何代码。我们致力于协作并帮助编码，而不是为您提供代码服务。
你能编辑你的帖子并把它放在那里吗？在评论中阅读有点困难。一旦你更新了就说。如果您从 VBA 复制，请确保在突出显示代码后放置一个制表符（基本上是 4 个空格），这样您可以更轻松地粘贴。否则，您需要在帖子的每一行之前放置 4 个空格，以便代码工具将其拾取。
已更新以包含当前代码。
要在 VBA 中平均，您可以使用 Application.WorksheetFunction.Average(Range("GReview").Value)。具有命名范围的公式将是 =AVERAGE(GReview)
我已经编辑了我的原始帖子，希望让它更清晰一点。

标签： excel excel-formula vba

【解决方案1】：

所以在玩和研究之后，我能够解决我自己的问题。如果有人有任何更简洁的编码方式，请随时添加。

Sub b_form()
Dim c As Range
Dim myform As String
Dim r As Long
Dim x As Long

mytotal = 0
x = 1
ThisWorkbook.Sheets("Score").Select
Cells(1, 1).Select

' count rows in a named range
Dim oRng As Range, lRows As Long
lRows = 0
For Each oRng In Range("GReview").Areas
lRows = lRows + oRng.Rows.Count
Next oRng

'Gets sheetnames and cells to build dynamic formula
 For r = 3 To 5
    For Each c In Range("GReview")
        If x <> lRows Then
            myform = myform + c & "!" & Cells(2, r).Address(RowAbsolute:=False, ColumnAbsolute:=True) & ","
        Else
            myform = myform + c & "!" & Cells(2, r).Address(RowAbsolute:=False, ColumnAbsolute:=True)
        End If
        x = x + 1
    Next c
        ThisWorkbook.Worksheets("Score").Cells(2, r) = "=Average(" & myform & ")"
        myform = ""
        x = 1
Next r
' this calculation is no longer needed at this time
'Sheets("Score").Range("F2") = "=($C2*$D2)-(($C2*$D2)*($E2/5))"
 lr = get_lr(2)

With Sheets("Score").Range("C2:E" & lr)
    .FillDown
End With


End Sub

【讨论】：