Ako doplniť víkendy do časovej rady

 

Ako ste si už stihli všimnúť, sága článkov o tom, ako radím niekoľkým ľuďom pokračuje. Dnes tu máme niečo z prostredia banky – tradingu. 

Dotaz znel nasledovne: upraviť časovú radu tak, aby obsahovala víkendy a hodnoty Open, Close, Min, Max, Adj. Close a Volume boli kĺzavým priemerom za 5 predchádzajúcich dní.

Daný problém vyzerá nasledovne (použijeme funkciu =TEXT(adresa bunky, “dddd”), aby sme videli názvy dní).

Všimnite si, že za dňom Friday, nenasleduje Saturday a taktiež Sunday. Preto nasledujúce makro bude hľadať dátum, ktorý je piatkom. Ak nájde takýto dátum, vloží nad neho dva prázdne riadky, doplní dátumy a kĺzavé priemery (=AVERAGE(posledných 5 dní)). Taktiež som ošetril možnosť, ak by ako prvá hodnota bola piatkom (v tom prípade by sme už extrapolovali o dva dni do budúcna hodnoty).

Riešenie:

Sub DoplnData()

Application.ScreenUpdating = False

Dim UB
Dim RB
Dim i
Dim j
Dim APW

'Najde veľkosť tabuľky
UB = Cells(Rows.Count, 1).End(xlUp).Row
RB = Cells(1, Columns.Count).End(xlToLeft).Column

Set APW = Application.WorksheetFunction
For i = 2 To UB
    'Ošetrenie ak by prvá hodnota bola piatková, preskočí proces
    If Application.WorksheetFunction.Text(Cells(i, 1), "dddd") = "Friday" Then
    If i = 2 Then
        GoTo koniec
    End If
        'Tento proces sa opakuje 2x - sobota aj nedeľa
        For j = 1 To 2
            'Vloží riadok a do neho dopočíta kĺzavé priemery
            Cells(i, 1).EntireRow.Insert
            Cells(i, 1).Value = Cells(i + 1, 1) + 1
            Cells(i, 2).Value = APW.Average(Range(Cells(i, 2), Cells(i + 5, 2)))
            Cells(i, 3).Value = APW.Average(Range(Cells(i, 3), Cells(i + 5, 3)))
            Cells(i, 4).Value = APW.Average(Range(Cells(i, 4), Cells(i + 5, 4)))
            Cells(i, 5).Value = APW.Average(Range(Cells(i, 5), Cells(i + 5, 5)))
            Cells(i, 6).Value = APW.Average(Range(Cells(i, 6), Cells(i + 6, 6)))
            Cells(i, 7).Value = APW.Average(Range(Cells(i, 7), Cells(i + 7, 7)))
        Next j
   
    End If
   
koniec:
    i = i + 2
       
Next i

Application.ScreenUpdating = True

End Sub

Celý súbor spolu s cvičným dataset-om si môžete stiahnuť kliknutím na obrázok. Pamätajte, na Facebook-u mi môžete poslať svoj dotaz, rád Vám naň odpoviem – stačí like kliknutím na logo dole.