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

SUMBER

Related Post :