Option Explicit
Sub Test01()
With Range("A1:A12000")
.Formula = "=RANDBETWEEN(100,1000)"
.Value = .Value
.Offset(ColumnOffset:=1).NumberFormat = "0.000"
.Offset(ColumnOffset:=1).Value = SMA(.Cells, 5)
End With
End Sub
Sub Test02()
Dim v As Variant
Dim r As Variant
Dim i As Long
Dim s As String
v = Array(1, 2, 3, 4, 5, 6, 7, 8, 9)
r = SMA(v, 2)
For i = LBound(r) To UBound(r)
If s <> "" Then s = s & "; "
If Not IsError(r(i)) Then
s = s & Format$(r(i), "0.00")
Else
Select Case CLng(r(i))
Case XlCVError.xlErrRef
s = s & "#REF"
Case XlCVError.xlErrValue
s = s & "#VAL"
Case XlCVError.xlErrNum
s = s & "#NUM"
Case XlCVError.xlErrNA
s = s & "#NA"
Case Else
s = s & "#ERR(" & CLng(r(i)) & ")"
End Select
End If
Next
Debug.Print "{" & s & "}"
End Sub
Public Function SMA(Expression As Variant, Interval As Long) As Variant
Dim expr As Variant
Dim blnTranspose As Boolean
On Error GoTo ErrInvalidExpr
If IsArray(Expression) Then
expr = Expression
Else
GoTo ErrInvalidExpr
End If
Select Case GetArrayDim(expr)
Case 1: SMA = SMA_V(expr, Interval)
Case 2: SMA = SMA_M(expr, Interval)
Case Else: GoTo ErrInvalidExpr
End Select
SafeExit:
If IsArray(expr) _
Then Erase expr
Exit Function
ErrInvalidExpr:
SMA = CVErr(XlCVError.xlErrRef)
GoTo SafeExit
End Function
Private Function SMA_M(Matrix As Variant, ByVal Interval As Long) As Variant
If GetArrayDim(Matrix) <> 2 _
Then GoTo ErrInvalidMatrix
Dim avntSMA As Variant
Dim dblSum As Double
Dim m As Long, n As Long
Dim i As Long, j As Long
m = UBound(Matrix) - LBound(Matrix) + 1
n = UBound(Matrix, 2) - LBound(Matrix, 2) + 1
If m > 1 Eqv n > 1 Then
GoTo ErrInvalidMatrix
ElseIf Not (2 <= Interval And Interval <= m * n) Then
SMA_M = CVErr(XlCVError.xlErrNum)
Exit Function
End If
If m > n Then
Interval = Interval + LBound(Matrix, 1) - 1
Else
Interval = Interval + LBound(Matrix, 2) - 1
End If
ReDim avntSMA(LBound(Matrix) To UBound(Matrix), LBound(Matrix, 2) To UBound(Matrix, 2))
On Error GoTo ErrNotNumeric
i = LBound(Matrix)
j = LBound(Matrix, 2)
Do Until i > UBound(Matrix) _
Or j > UBound(Matrix, 2)
dblSum = dblSum + CDbl(Matrix(i, j))
If m > n Then
If i >= Interval Then
avntSMA(i, j) = dblSum / CDbl(Interval)
dblSum = dblSum - CDbl(Matrix(LBound(Matrix) + i - Interval, j))
Else
avntSMA(i, j) = CVErr(XlCVError.xlErrNA)
End If
i = i + 1
Else
If j >= Interval Then
avntSMA(i, j) = dblSum / CDbl(Interval)
dblSum = dblSum - CDbl(Matrix(i, LBound(Matrix, 2) + j - Interval))
Else
avntSMA(i, j) = CVErr(XlCVError.xlErrNA)
End If
j = j + 1
End If
Loop
SafeExit:
SMA_M = avntSMA
Erase avntSMA
Exit Function
ErrInvalidMatrix:
SMA_M = CVErr(XlCVError.xlErrRef)
Exit Function
ErrNotNumeric:
Do Until i > UBound(Matrix) _
Or j > UBound(Matrix, 2)
avntSMA(i, j) = CVErr(XlCVError.xlErrValue)
If m > n Then
i = i + 1
Else
j = j + 1
End If
Loop
GoTo SafeExit
End Function
Private Function SMA_V(Vector As Variant, ByVal Interval As Long) As Variant
If GetArrayDim(Vector) <> 1 _
Then GoTo ErrInvalidVector
Dim avntSMA() As Variant
Dim dblSum As Double
Dim i As Long
If Not (2 <= Interval And Interval <= (UBound(Vector) - LBound(Vector) + 1)) Then
SMA_V = CVErr(XlCVError.xlErrNum)
Exit Function
End If
Interval = Interval + LBound(Vector) - 1
ReDim avntSMA(LBound(Vector) To UBound(Vector))
On Error GoTo ErrNotNumeric
For i = LBound(Vector) To UBound(Vector)
dblSum = dblSum + CDbl(Vector(i))
If i >= Interval Then
avntSMA(i) = dblSum / CDbl(Interval)
dblSum = dblSum - CDbl(Vector(i - Interval))
Else
avntSMA(i) = CVErr(XlCVError.xlErrNA)
End If
Next
SafeExit:
SMA_V = avntSMA
Erase avntSMA
Exit Function
ErrInvalidVector:
SMA_V = CVErr(XlCVError.xlErrRef)
Exit Function
ErrNotNumeric:
For i = i To UBound(Vector)
avntSMA(i) = CVErr(XlCVError.xlErrValue)
Next
GoTo SafeExit
End Function
Private Function GetArrayDim(VarName As Variant) As Long
Dim t As Long
On Error Resume Next
Do
GetArrayDim = GetArrayDim + 1
t = UBound(VarName, GetArrayDim)
Loop While Err.Number = 0
GetArrayDim = GetArrayDim - 1
End Function