Excel 创建公式、相同单元格、动态张数

我已经创建了一个工作簿，其中有两张工作表，它们将始终存在：“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

。在计分表的

单元格C2

中，公式应为

=平均值（迈克！C2，希拉！C2，汤姆！C2，马特！C2）

，在

单元格D2中，公式应为
=平均值（迈克！D2，希拉！D2，汤姆！D2，马特！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

所以在游戏和研究之后，我能够解决我自己的问题。如果有人有更简洁的编码方法，请随意添加

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

Sub b_form（）
调光范围
将myform设置为字符串
变暗，变长
暗x等长
mytotal=0
x=1
此工作簿。工作表（“分数”）。选择
单元格（1，1）。选择
'计算命名范围内的行数
暗的或像射程一样远的
lRows=0
对于范围内的每个oRng（“GReview”）。区域
lRows=lRows+oRng.Rows.Count
下一个
'获取要生成动态公式的图纸名称和单元格
对于r=3到5
对于范围内的每个c（“GReview”）
如果x lRows那么
myform=myform+c&“！”&单元格（2，r）.地址（RowAbsolute:=False，ColumnAbsolute:=True）和“，”
其他的
myform=myform+c&“！”&单元格（2，r）.地址（RowAbsolute:=False，ColumnAbsolute:=True）
如果结束
x=x+1
下一个c
此工作簿。工作表（“分数”）。单元格（2，r）=“=平均值（“&myform&”）
myform=“”
x=1
下一个r
"目前不需要再进行这一计算
'表格（“分数”）。范围（“F2”）=“=（$C2*$D2）-（$C2*$D2）*（$E2/5））”
lr=get_lr（2）
带图纸（“分数”）。范围（“C2:E”和lr）
.菲尔顿
以
端接头
请提供您尝试过的所有代码。我们这样做是为了合作和帮助编码，而不是为你服务的代码。你能编辑你的帖子并把它放在那里吗？在评论中读起来有点难。更新后就说。如果要从VBA复制，请确保在突出显示代码后放置一个选项卡（基本上是4个空格），这样可以更轻松地粘贴。否则，您需要在文章中的每一行前面放置4个空格，以便代码工具将其拾取。更新为包含当前代码。要在VBA中平均，您可以使用Application.WorksheetFunction.average（范围（“GReview”）.Value）。命名范围的公式是=AVERAGE（GReview）。我编辑了我的原始帖子，希望能让它更清晰一些。