Aineisto aikasarjamuotoon?

Tjswg

Osaisiko joku auttaa?

Lähtöaineisto on yli 10 000 havainnon lista päivystysvuoroja tekijöineen muodossa:
Henkilö. Alkupäivä. Loppupäivä. Kesto

eli esim: matti. 3.1.2017. 6.1.2017. 4
maija 9.1.2017. 10.1.2017. 2

Samalla henkilöllä on listalla useampia rivejä, jokaisella eri määrä ja vuorot ovat erimittaisia ja menevät henkilöiden välillä osin pällekkäin. Henkilöitä listassa on reilu 400.
Miten saisin tuon sellaiseen muotoon,että yhtenä sarakkeena on aika juoksevana päivämääränä koko vuosi 1.1._31.12, siis yksi rivi/päivä. Ja ihmiset olisivat jokainen oma sarakkeensa, jossa olisi arvo 1 niiden päivien kohdalla,jolloin on päivystänyt, ja muiden päivien kohdalla arvo 0. Eli:

Matti. Maija. Jne.
1.1.2017. 0. 0
2.1.2017. 0. 0
3.1.2017. 1. 0
4.1.2017. 1. 0
5.1.2017. 1. 0
6.1.2017. 1. 0
7.1.2017. 0. 0
8.1.2017. 0. 0
9.1.2017. 0. 1
10.1.2017. 0. 1
11.1.2017. 0. 0
jne.

Jollain kaavalla varmasti menee, mutta millä ???

1

157

    Vastaukset

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • Kundepuu

      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

    Ketjusta on poistettu 0 sääntöjenvastaista viestiä.

    Luetuimmat keskustelut

    1. Hengenvaaralliset kiihdytysajot päättyivät karmealla tavalla, kilpailija kuoli

      Onnettomuudesta on aloitettu selvitys. Tapahtuma keskeytettiin onnettomuuteen. Tapahtumaa tutkitaan paikan päällä yhtei
      Kauhava
      197
      6861
    2. Ootko rakastunut?

      Kerro pois nyt
      Ikävä
      159
      2026
    3. Onhan sulla nainen parempi mieli

      Nyt? Ainakin toivon niin.
      Ikävä
      113
      1678
    4. Ujosteletko tosissaan vai mitä oikeen

      Himmailet???? Mitä pelkäät?????
      Ikävä
      51
      1380
    5. Suureksi onneksesi on myönnettävä

      Että olen nyt sitten mennyt rakastumaan sinuun. Ei tässä mitään, olen kärsivällinen ❤️
      Ikävä
      55
      1228
    6. Möykkähulluus vaati kuolonuhrin

      Nuori elämä menettiin täysin turhaan tällä järjettömyydellä! Toivottavasti näitä ei enää koskaan nähdä Kauhavalla! 😢
      Kauhava
      50
      1098
    7. Älä mies pidä mua pettäjänä

      En petä ketään. Älä mies ajattele niin. Anteeksi että ihastuin suhun varattuna. Pettänyt en ole koskaan ketään vaikka hu
      Ikävä
      100
      1064
    8. Reeniähororeeniä

      Helvetillisen vaikeaa työskennellä hoitajana,kun ei kestä silmissään yhtään läskiä. Saati hoitaa sellaista. Mitä tehdä?
      Kouvola
      6
      977
    9. Tarvitsemme lisää maahanmuuttoa.

      Väestö eläköityy, eli tarvitsemme lisää tekeviä käsiä ja veronmaksajia. Ainut ratkaisu löytyy maahanmuutosta. Nimenomaan
      Maailman menoa
      251
      944
    10. Kävit nainen näemmä mun

      Facessa katsomassa....
      Ikävä
      41
      919
    Aihe