티스토리 뷰

Sub lagged_correl()
'// Automating Calculation of Lagged Cross Correlations between Variables
    Const ROWEND = 417  '// change value as your own
    Const ROWBEGIN = 2  '// change value as your own
    Const COLBEGIN = 2  '// change value as your own
    Const OBS = 31      '// change value as your own
   
    Dim s As Worksheet
    Dim s3 As Worksheet
    Dim lags
    Dim rng(1 To OBS) As Range
    Dim rng1 As Range, rng2 As Range
    Dim col As Long
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim r As Long
   
    Set s = Sheet1
    Set s3 = Sheet3
   
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
   
    col = COLBEGIN
    lags = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
   
    For i = 1 To OBS
Set rng(i) = s.Range(s.Cells(ROWBEGIN, col), s.Cells(ROWEND, col))
        col = col + 1
    Next
   
    r = 2
    For j = 0 To UBound(lags)
       
        For k = 1 To OBS
            For i = 1 To OBS
                If k <> i Then
                    Set rng1 = s.Range(rng(k).Cells(1, 1).Offset(j, 0), rng(k).Cells(rng(k).Rows.Count, 1))
                    Set rng2 = s.Range(rng(i).Cells(1, 1), rng(i).Cells(rng(i).Rows.Count - j, 1))
                   
                    s3.Cells(r, 1) = j
                    s3.Cells(r, 2) = "(" & k & "," & i & ")"
                    s3.Cells(r, 3) = rng1.Address
                    s3.Cells(r, 4) = rng2.Address
                    s3.Cells(r, 5) = Application.WorksheetFunction.CORREL(rng1, rng2)
                    r = r + 1
                End If
            Next
        Next
       
    Next
   
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
End Sub


출처 : http://timebird.egloos.com/page/4

'Language > EXCEL VBA' 카테고리의 다른 글

정규누적확률분포  (1) 2008.06.25
Random walk  (0) 2008.06.23
시트 상의 data 카운트 방법  (0) 2008.06.23
입력된 셀 값을 받아서 재 입력하기  (0) 2008.06.23
[fuction] TRIM(text)  (0) 2008.06.17