vba - 从 Vba 中的多个工作表中收集平均值

Question

我需要从几个工作表中计算某个范围的平均值(“C2:C11”)到一个新的工作表中。如果添加了新工作表并将数据输入到指定范围，该功能应该仍然有效。

到目前为止我有这个

……

Sheets.Add

Dim myavg As Collection
Set myavg = New Collection

For Each wsheet In Worksheets
   myavg.Add wsheet.Range("B2:B11")
Next    
For i = 1 To myavg.Count
   avg1 = Application.WorksheetFunction.Average(Range("B2:B11"))
Next

curColumn = 5
curRow = 4

For i = 1 To myavg.Count
   ActiveSheet.Cells(curRow, curColumn).Value = avg1
   curRow = curRow + 1
Next  

...

它将一个数字返回到新工作表的所需范围内，并且不准确

请帮助我理解我做错了什么。
先感谢您。

Answer 1

暂且不论 Collection是这个任务的好主意，让我们检查您的代码:

一般的
你可能已经这样做了，但它不会重复
使用Option Explicit并标记所有变量

你的代码

Sheets.Add

这增加了一个新的 Worksheet给活跃的 Workbook ，并将其放在当前事件工作表之前，然后激活新工作表。
问题:
您依靠默认行为来获取新的 Worksheet ，您无法确定新工作表的位置，并且您没有引用它。
建议:
获取对工作簿对象的引用并在整个代码中使用它

Dim wb As Workbook
Set wb = ActiveWorkbook

控制添加到工作簿的内容、位置和方式

Dim wsSummary as Worksheet
Set wsSummary = wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count))
wsSummary.Name = "Summary"

你的代码

For Each wsheet In Worksheets
    myavg.Add wsheet.Range("B2:B11")
Next  

这将创建一个 Collection的 Range的，从每个 Worksheet在书中，包括我们刚刚创建的那个。我猜你不想包括那个。为了便于维护，您应该创建一个变量来保存范围并在整个代码中使用它。
让我们应用上述内容

Dim wsheet as WorkSheet
Dim RangeAddress As String
RangeAddress = "B2:B11"
For Each wsheet In wb.Worksheets
    If wsheet.name <> wsSummary.Name Then
        myavg.Add wsheet.Range(RangeAddress)
    End If
Next  

你的代码

For i = 1 To myavg.Count
    avg1 = Application.WorksheetFunction.Average(Range("B2:B11"))
Next

问题:
您正在迭代 Collection但不在循环中引用它。每次通过你计算 avg1然后在下一个循环中覆盖它。
每次通过循环，您都会计算事件工作表上某个范围的平均值(这将是刚刚添加的空白新工作表)
建议:
继续前进，您似乎想在新工作表上列出平均值，在连续行中每张工作表一个。因此，让我们将平均值存储在一个数组中，以便稍后放在汇总表上。请注意，如果 Range 中的任何一个是空的， Average会导致错误。

Dim avg() as Variant
Redim avg(1 to myavg.Count, 1 To 1)
For i = 1 To myavg.Count
    avg(i, 1) = Application.WorksheetFunction.Average(myavg(i))
Next

你的代码

curColumn = 5
curRow = 4

For i = 1 To myavg.Count
    ActiveSheet.Cells(curRow, curColumn).Value = avg1
    curRow = curRow + 1
Next

问题:
这段代码只是把最后计算的值 avg1到连续的行

将结果放到新工作表上:将平均值收集到一个数组中，让我们把它放到工作表上

Dim curColumn as Long, curRow As Long
curColumn = 5
curRow = 4

wsSummary.Cells(curRow, curColumn).Resize(UBound(avg, 1), 1) = avg

到目前为止没有删除的是 Error Handling .代码出错的方式有很多种，因此明智的做法是包含 Error Handling在你的代码中。例如，如果已经有一个名为“摘要”的工作表怎么办？如果 Average返回错误？

谈到这是否是一个好方法，应该清楚的是，在创建了一个数组来保存结果之后，可以在工作簿的传递中填充该数组。

像这样的东西

Sub Demo()
    Dim wb As Workbook
    Set wb = ActiveWorkbook

    Dim RangeAddress As String
    RangeAddress = "B2:B11"

    Dim wsSummary As Worksheet

    Dim avg() As Variant
    ReDim avg(1 To wb.Worksheets.Count, 1 To 1)
    For i = 1 To UBound(avg, 1)
        With wb.Worksheets(i).Range(RangeAddress)
            If WorksheetFunction.Count(.Value) > 0 Then
                avg(i, 1) = WorksheetFunction.Average(.Value)
            Else
                avg(i, 1) = "No Values On Sheet"
            End If
        End With
    Next

    Dim curColumn As Long, curRow As Long
    curColumn = 5
    curRow = 4

    On Error Resume Next
    Set wsSummary = wb.Worksheets("Summary")
    If Err.Number <> 0 Then
        ' Summary sheet does not exist, create it
        Err.Clear
        On Error GoTo 0
        Set wsSummary = wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count))
        wsSummary.Name = "Summary"
    Else
        On Error GoTo 0
        ' Summary sheet already exists
        ' what do you wnat to do?
    End If

    wsSummary.Cells(curRow, curColumn).Resize(UBound(avg, 1), 1) = avg

End Sub

此代码可能仍然存在问题，具体取决于您的确切要求(例如，如果“摘要”表已经存在，这将在平均循环中处理它)