Excel用户定义的函数返回所有工作表中的相同范围的平均值，但这是一个

如果我知道有多less工作表，我可以用一个公式来做到这一点。 但是我想在第一个工作表上创build一个用户定义的函数，这个函数将会从第二个工作表循环到最后一个工作表，不pipe有多less个工作表。 无论我尝试什么，当我尝试引用另一个工作表时，我都会遇到#VALUE错误。 例如，这不起作用：

Function AVERANK(rng As Range) ' user passes the range in which people may have entered a rank for this benefit Dim ws As Integer ' variable to hold worksheet index and increment through loop Dim pageAve As Single ' variable to hold average value of the passed range for one worksheet, since people put their rank in different cells ' or put two ranks for one benefit Dim ave As Single ' variable to hold the running total of rank Dim cnt As Integer ' variable to hold count of worksheets for calculating average rank over all worksheets cnt = 0 ' count starts as zero, incremented each time loop goes through a worksheet ave = 0 ' average starts as zero, each worksheet's rank is added to it For ws = 2 To ws = ActiveWorkbook.Worksheets.count ' loop through all the worksheets but the first one pageAve = Application.WorksheetFunction.Average(Worksheets(ws).rng) ' sets pageAve to the average of the target range on this worksheet ave = ave + pageAve ' adds this worksheet's rank to the running total of rank cnt = cnt + 1 ' counts this worksheet Next AVERANK = ave / cnt ' calculates average rank of benefit over all worksheets End Function 

这似乎现在对我有用：

 Function WORKBOOKAVE(rng As Range) ' user passes the range in which people may have entered a rank for this benefit Dim w As Long ' variable to hold worksheet index and increment through loop Dim ave As Double ' variable to hold the running total of rank Dim cnt As Long ' variable to hold count of worksheets for calculating average rank over all worksheets For w = 1 To ActiveWorkbook.Worksheets.count ' loop through all the worksheets With Worksheets(w) If .Name <> rng.Parent.Name Then ' excludes the worksheet in which the function was entered ave = ave + Application.Average(.Range(rng.Address)) ' adds this worksheet's rank to the running total of rank On Error GoTo ErrHandler: cnt = cnt + 1 ' counts this worksheet End If End With Next WORKBOOKAVE = ave / cnt ' calculates average rank of benefit over all worksheets ErrHandler: ave = ave + 7 ' if they left this row blank, causing an error when calculating the average, assign the worst rank: 7 Resume Next 'go back to the next line which counts this worksheet End Function 

Answer 1

你可以减less一些代码行。

 Function AVERANK(rng As Range) ' user passes the range in which people may have entered a rank for this benefit Dim w As Long ' variable to hold worksheet index and increment through loop Dim ave As Double ' variable to hold the running total of rank Dim cnt As Long ' variable to hold count of worksheets for calculating average rank over all worksheets For w = 1 To ActiveWorkbook.Worksheets.Count ' loop through all the worksheets but the first one With Worksheets(w) 'next line adjusted to include #DIV/0! error control as per Axel Richter's approach above If .Name <> rng.Parent.Name And CBool(Application.Count(.Range(rng.Address))) Then ' sets pageAve to the average of the target range on this worksheet ave = ave + Application.Average(.Range(rng.Address)) ' adds this worksheet's rank to the running total of rank cnt = cnt + 1 ' counts this worksheet End If End With Next AVERANK = ave / cnt ' calculates average rank of benefit over all worksheets End Function 

宣布的数字从零开始; 在使用之前不需要将它们分配为0 。 传入的rng参数具有函数所在的工作表的父工作表，可用于从考虑事项中放弃该工作表。

Answer 2

有很多问题。

For ws = 2 To ws = ActiveWorkbook.Worksheets.count不是For ... Next的正确语法。 For ws = 2 To ActiveWorkbook.Worksheets.count会。

Worksheets(ws).rng不起作用。 如果您需要在实际WS中给定rng的相同地址的范围，那么Worksheets(ws).Range(rng.Address)将起作用。

Application.WorksheetFunction.Average将返回一个Double而不是Single 。

如果Range中没有值， Application.WorksheetFunction.Average将导致#DIV/0错误。 所以我们应该抓住那个错误。

所以以下应该工作：

 Function AVERANK(rng As Range) As Double Dim ws As Integer Dim pageAve As Double Dim ave As Double Dim cnt As Integer Dim oActWS As Worksheet Dim oActRange As Range With ActiveWorkbook For ws = 2 To .Worksheets.Count ' right syntax For ... Next Set oActWS = .Worksheets(ws) Set oActRange = oActWS.Range(rng.Address) ' Range of the same address of given rng in the act. WS pageAve = 0 ' set pageAve=0 because if error, then it would remain the value from the worksheet before On Error Resume Next ' if there are no values, then there is a #DIV/0 error with Avarage pageAve = Application.WorksheetFunction.Average(oActRange) On Error GoTo 0 ave = ave + pageAve cnt = cnt + 1 Next End With AVERANK = ave / cnt End Function