Aineisto aikasarjamuotoon?

moduuliin...
muuta taulukon nimet sopiviksi


Option Explicit
Dim solu As Range
Dim Vika As Double
Dim i As Long
Dim j As Long
Dim EiTupla As New Collection
Dim Löydetty As Range
Sub teetaulukko()
On Error Resume Next
Application.DisplayAlerts = False
Sheets("Huuhaa").Delete

PoistaTuplat

Sheets.Add.Name = "Huuhaa"
Cells(1, 1) = "PVM"
Range("A2").FormulaR1C1 = "1/1/2017"
Range("A2").AutoFill Destination:=Range("A2:A366"), Type:=xlFillDefault
Range("A2:A366").NumberFormat = "d/m"
For i = 1 To EiTupla.Count
Worksheets("Huuhaa").Cells(1, i 1) = EiTupla(i)
EtsiJaSiirrä2 EiTupla(i), i
Next
Worksheets("Huuhaa").Range("B2").Resize(365, EiTupla.Count 1).SpecialCells(xlCellTypeBlanks) = 0
Application.DisplayAlerts = False
End Sub

Sub KirjoitaVuorot(Alku As Date, Loppu As Date, Siirtymä As Long)
Dim AlkuPäivänro As Variant
Dim LoppuPäivänro As Variant

If Loppu - Alku <= 0 Then
Exit Sub
End If
AlkuPäivänro = CDbl(Alku - DateValue("1.1") 1)
LoppuPäivänro = CDbl(Loppu - DateValue("1.1") 1)
For j = AlkuPäivänro To LoppuPäivänro
Worksheets("Huuhaa").Range("A1").Offset(j, Siirtymä) = 1
Next
End Sub
Function EtsiJaSiirrä2(Hakuehto As Variant, Sarake As Long) As Range

Dim solu As Range
Dim EkaOsoite As String
Worksheets("Sheet1").Activate
With Range("A:A")
Set solu = .Find( _
What:=Hakuehto, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not solu Is Nothing Then
EkaOsoite = solu.Address
Do
KirjoitaVuorot solu.Offset(0, 1), solu.Offset(0, 2), Sarake
Set solu = .FindNext(solu)
Loop While Not solu Is Nothing And solu.Address <> EkaOsoite
End If
End With
End Function
Sub PoistaTuplat()
On Error Resume Next
Vika = Worksheets("Sheet1").Range("A65536").End(xlUp).Row
For Each solu In Range("A1:A" & Vika)
EiTupla.Add solu, CStr(solu)
Next
End Sub


Keep EXCELing
@Kunde