<div style="text-indent: 2em;">

示例欢迎通过以下网址下载:
http://www.myfootprints.cn/blog/upload/ACF_PACF.xls

以下是vba 模块:

注:传入ACF()函数的参数必须是已经中心化后的数组。而传入PACF()函数的参数是由ACF()函数计算出来的数组序列。

使用中心化后的相同的数据在本Excel文件中和在SAS软件中计算的结果是一致的。

如:下载后示例文件后,将如下数据在SAS软件中计算其自相关函数与偏自相关函数:

-5.552941176
-3.352941176
-1.552941176
-4.152941176
-1.552941176
-4.152941176
-3.152941176
-2.152941176
-1.152941176
-0.152941176
0.847058824
1.847058824
2.847058824
3.847058824
4.847058824
5.847058824
6.847058824

SAS 程序为:

data mydata;
input x;
cards;
-5.552941176
-3.352941176
-1.552941176
-4.152941176
-1.552941176
-4.152941176
-3.152941176
-2.152941176
-1.152941176
-0.152941176
0.847058824
1.847058824
2.847058824
3.847058824
4.847058824
5.847058824
6.847058824
;
run;

proc arima; identify var = x nlag = 864 outcov = out1; run;

计算自相关函数的的自定义函数是acf(),偏自关函数是pacf(),它们的参数都是一组数据,而这组数据来自excel中的单元格范围,故它们都调用了一个函数,用来将excel的单元格范围转化成一个数组,这个函数就是range2array()。

range2array()的算法很简单,用for each循环将range中的每一个数字逐个填充到预先定义好的array()中。而这个array()的大小,与range中的单元格数相同。

acf()的算法,即是根据样本自相关函数的定义而实现的。即

而pacf()的算法,也是根据偏自相关函数的定义来的。即

在pacf()中,先根据输入的参数数组,分别得到分母矩阵和分子矩阵,然后分别对分母矩阵和分子矩阵求行列式值。最后相除即可。

分母矩阵实际上是一个对称矩阵,而且观察后可以发现有这样的规律,即,每个元素的下标,都是其行列号的差的绝对值

而分子矩阵,除了最后一列,其他的元素都与分母矩阵相同。

Option Explicit
'Option Private Module

'''''''''''''''''''''''''''''''''' ' 计算列数据的自相关函数 ' '''''''''''''''''''''''''''''''''' Public Function ACF(ByRef rng As Range, ByVal k As Long) As Double Dim dDenominator As Double Dim dNumerator As Double Dim daX() As Variant Dim i As Long Dim lUB As Long, lLB As Long

daX = Range2Array(rng)

'计算分子
dNumerator = 0
lUB = UBound(daX)
lLB = LBound(daX)
For i = lLB + k To lUB
    dNumerator = dNumerator + daX(i) * daX(i - k)
Next i

'计算分母
dDenominator = 0
For i = lLB To lUB
    dDenominator = dDenominator + daX(i) * daX(i)
Next i

ACF = dNumerator / dDenominator

End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' 计算列数据的偏自相关函数 ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Public Function PACF(ByRef rng As Range, ByVal k As Long) As Double Dim dDenominator As Double Dim dNumerator As Double Dim dMatrixDenominator() As Double Dim dMatrixNumerator() As Double Dim vArray() As Variant Dim i As Long, j As Long Dim sString As String

vArray = Range2Array(rng, 1)
vArray(LBound(vArray)) = 1

ReDim dMatrixDenominator(0 To k - 1, 0 To k - 1)
ReDim dMatrixNumerator(0 To k - 1, 0 To k - 1)

'生成分母矩阵

' sString = "分母矩阵:" & vbCrLf

For i = 0 To k - 1
    For j = 0 To k - 1
        dMatrixDenominator(i, j) = CDbl(vArray(Abs(i - j)))

' sString = sString & dMatrixDenominator(i, j) & vbTab Next j ' sString = sString & vbCrLf Next i ' Debug.Print sString

'生成分子矩阵
For i = 0 To k - 1
    For j = 0 To k - 2
        dMatrixNumerator(i, j) = CDbl(vArray(Abs(i - j)))
    Next j
Next i
For i = 0 To k - 1
    dMatrixNumerator(i, k - 1) = CDbl(vArray(i + 1))
Next i

' sString = "分子矩阵:" & vbCrLf ' For i = 0 To k - 1 ' For j = 0 To k - 1 ' sString = sString & dMatrixNumerator(i, j) & vbTab ' Next j ' sString = sString & vbCrLf ' Next i ' Debug.Print sString

'计算PACF(k,k)
PACF = Application.WorksheetFunction.MDeterm(dMatrixNumerator) / Application.WorksheetFunction.MDeterm(dMatrixDenominator)

End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' 求和 ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Public Function SigmaSum(ByRef rng As Range, ByVal lBegin As Long, ByVal lEnd As Long, ByVal power As Double) As Double SigmaSum = 0

Dim i As Long

For i = lBegin To lEnd
    SigmaSum = SigmaSum + CDbl(rng.Cells(i).Value) ^ power
Next i

End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' 将Range转换成数组 (变体型) ' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Private Function Range2Array(ByRef rng As Range, Optional ByVal lOffset As Long = 0) As Variant() Dim vaRet() As Variant Dim i As Long Dim rngCell As Range

ReDim vaRet(0 To rng.Cells.Count - 1)
i = lOffset
For Each rngCell In rng
    vaRet(i) = rngCell.Value
    If i &gt;= UBound(vaRet) Then
        Exit For
    End If
    i = i + 1
Next rngCell

Range2Array = vaRet

End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' 将Range转换成数组 (双精度型) ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Private Function Range2ArrayDouble(ByRef rng As Range) As Double() Dim daRet() As Double Dim i As Long Dim rngCell As Range

ReDim vaRet(0 To rng.Cells.Count - 1)
i = 0
For Each rngCell In rng
    On Error Resume Next
    daRet(i) = CDbl(rngCell.Value)
    If Err.Number &lt;&gt; 0 Then
        daRet(i) = 0
        Err.Clear
    End If
    i = i + 1
Next rngCell

Range2ArrayDouble = daRet

End Function

 

示例文件:ACF_PACF.xls