aar
Gold Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Functions for calculating the Min, Max and StdDev
The following functions can be used to calculate the minimum, maximum and standard deviation of a list of arguments.
Option Explicit
'Purpose : Returns the Minimum value from a parameter Array
'Inputs : avValues() as Variant
'Outputs : The Min Value contained within the input (excluding empty values)
'Notes : Examples:
' Min(1,2,empty,-1) Returns -1
' Min(Array(1,2,-1),-4,-9.9) Returns -9.9
' Min(1/Jan/99,2/Jan/99) Returns 1/Jan/99
'Revisions :
Function Min(ParamArray avValues() As Variant) As Variant
Dim vThisItem As Variant, vThisElement As Variant
On Error Resume Next
For Each vThisItem In avValues
If IsArray(vThisItem) Then
For Each vThisElement In vThisItem
Min = Min(vThisElement, Min)
Next
Else
If vThisItem < Min Then
If Not IsEmpty(vThisItem) Then
Min = vThisItem
End If
ElseIf IsEmpty(Min) Then
Min = vThisItem
End If
End If
Next
On Error GoTo 0
End Function
'Purpose : Returns the Maximum value from a parameter Array
'Inputs : avValues() as Variant
'Outputs : The Max Value contained within the input (excluding empty values)
'Notes : Examples:
' Max(1,2,empty,-1) Returns 2
' Max(Array(1,2,-1),-4,-9.9) Returns 2
' Max(1/Jan/99,2/Jan/99) Returns 2/Jan/99
'Revisions :
Function Max(ParamArray avValues() As Variant) As Variant
Dim vThisItem As Variant, vThisElement As Variant
On Error Resume Next
For Each vThisItem In avValues
If IsArray(vThisItem) Then
For Each vThisElement In vThisItem
Max = Max(vThisElement, Max)
Next
Else
If vThisItem > Max Then
If Not IsEmpty(vThisItem) Then
Max = vThisItem
End If
ElseIf IsEmpty(Max) Then
Max = vThisItem
End If
End If
Next
On Error GoTo 0
End Function
'Purpose : Returns the Average of many things, they could be dates or numbers.
'Inputs : avValues A 1D Array of Values to evaluate
'Outputs : The average value of the input parameters
Function Average(ParamArray avValues() As Variant) As Variant
Dim vTotal As Variant, lThisItem As Variant, vThisElement As Variant, lItems As Long
For Each lThisItem In avValues
If IsArray(lThisItem) Then
For Each vThisElement In lThisItem
If Not IsEmpty(vThisElement) And IsNumeric(vThisElement) Then
vTotal = vTotal + vThisElement
lItems = lItems + 1
End If
Next
ElseIf Not IsEmpty(lThisItem) And IsNumeric(lThisItem) Then
vTotal = vTotal + lThisItem
lItems = lItems + 1
End If
Next
If lItems Then
Average = vTotal / lItems
End If
End Function
'Purpose : Calculate the Standard Devation of a population
'Inputs : avValues. A 1D Array of Values.
' [avWeights]. A 1D Array of weights. If supplied the function
' will calculated a weighted standard deviation.
'Outputs : The Standard Deviation or N/A if less than three values
Function StdDevP(avValues As Variant, Optional avWeights) As Variant
Dim dThisWeight As Double, lThisItem As Long
Dim dValue1 As Double, dValue2 As Double, dSumWeights As Double
On Error GoTo ErrFailed
If UBound(avValues) - LBound(avValues) >= 3 Then
'Have more than three values
dThisWeight = 1
For lThisItem = LBound(avValues) To UBound(avValues)
If IsArray(avWeights) Then
dThisWeight = avWeights(lThisItem)
End If
dValue1 = dValue1 + (dThisWeight * avValues(lThisItem) * avValues(lThisItem))
dSumWeights = dSumWeights + dThisWeight
dValue2 = dValue2 + (dThisWeight * avValues(lThisItem))
Next
dValue1 = dValue1 / dSumWeights
dValue2 = (dValue2 / dSumWeights) ^ 2
'Abs prevents a run time if round errors occur
'which make the number negative
StdDevP = Abs(dValue1 - dValue2) ^ 0.5
Else
'Require three values
StdDevP = "N/A"
End If
Exit Function
ErrFailed:
Debug.Print "Error in StdDevP: " & Err.Description
StdDevP = "N/A"
End Function |
