创建一个公式，相同的单元格，动态数量的床单

Question

我创建了一个工作簿，该工作簿有2张始终存在的表："主"one_answers"得分"。在主表上，我有一个指定的动态范围，例如，我将输入名称，例如（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。<<<<<<<<<<<<<</p>

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

Answer 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