Je pourrais simplement le faire avec une formule si je savais combien il y avait de feuilles de calcul. Mais je veux créer une fonction définie par l'utilisateur sur la première feuille de calcul qui passera de la deuxième à la dernière feuille de calcul, quel que soit le nombre. Quoi que j'essaye, lorsque j'essaye de me référer à une autre feuille de calcul, j'obtiens une erreur #VALUE. Cela, par exemple, ne fonctionne pas:

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

Cela semble fonctionner pour moi maintenant:

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
2
Jasmine Van Pelt 1 janv. 2016 à 14:48

2 réponses

Meilleure réponse

Vous pouvez réduire un peu les lignes de code.

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

Les nombres déclarés commencent leur vie à zéro; il n'est pas nécessaire de les attribuer en tant que 0 avant utilisation. Le paramètre rng transmis a la feuille de calcul parente de la feuille de calcul dans laquelle se trouve la fonction et qui peut être utilisée pour ignorer cette feuille de calcul.

2
1 janv. 2016 à 12:44

Il y a plusieurs problèmes.

For ws = 2 To ws = ActiveWorkbook.Worksheets.count n'est pas la bonne syntaxe pour For ... Next. For ws = 2 To ActiveWorkbook.Worksheets.count serait.

Worksheets(ws).rng ne fonctionnera pas. Si vous avez besoin de la plage de la même adresse de rng donnée dans le WS réel, alors Worksheets(ws).Range(rng.Address) fonctionnera.

Application.WorksheetFunction.Average renverra un Double pas un Single.

Application.WorksheetFunction.Average entraînera une erreur #DIV/0 s'il n'y a pas de valeurs dans Range. Nous devrions donc attraper cette erreur.

Donc, ce qui suit devrait fonctionner:

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
1
Axel Richter 1 janv. 2016 à 12:46