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

158

    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. Suureksi onneksesi on myönnettävä

      Että olen nyt sitten mennyt rakastumaan sinuun. Ei tässä mitään, olen kärsivällinen ❤️
      Ikävä
      93
      2129
    2. Perusmuotoiset TV-lähetykset loppu

      Nyt sanoo useiden HD-muotoistenkin kanavien kohdalla äly-TV, ettei kanava ole käytössä, haluatko poistaa sen? Kanavia
      Apua aloittelijalle
      167
      1557
    3. YLE Äänekosken kaupunginjohtaja saa ankaraa arvostelua

      Kaupungin johtaja saa ankaraa kritiikkiä äkkiväärästä henkilöstöjohtamisestaan. Uusin häirintäilmoitus päivätty 15 kesä
      Äänekoski
      74
      1339
    4. Euroopan lämpöennätys, 48,8, astetta, on mitattu Italian Sisiliassa

      Joko hitaampikin ymmärtää. Se on aivan liikaa. Ilmastonmuutos on totta Euroopassakin.
      Maailman menoa
      240
      1237
    5. No ei sun asunto eikä mikään

      muukaan sussa ole erikoista. 🤣 köyhä 🤣
      Ikävä
      73
      1190
    6. Hyvin. Ikävää nainen,

      Että vainoat ja stalkkaat miestäni.onko tarkoituksesi ehkä saada meidät eroamaan?no,siinä et tule onnistumaan
      Ikävä
      88
      1106
    7. Martina lähdössä Ibizalle

      Eikä Eskokaan tiennyt matkasta. Nyt ollaan jännän äärellä.
      Kotimaiset julkkisjuorut
      151
      1051
    8. Asiakas iski kaupassa varastelua tehneen kanveesiin.

      https://www.iltalehti.fi/kotimaa/a/33a85463-e4d5-45ed-8014-db51fe8079ec Oikein. Näin sitä pitää. Kyllä kaupoissa valtava
      Maailman menoa
      253
      1016
    9. Katsoin mies itseäni rehellisesti peiliin

      Ja pakko on myöntää, että rupsahtanut olen 😆. Niin se ikä saavuttaa meidät kaikki.
      Ikävä
      51
      936
    10. Uskomaton tekninen vaaliliitto poimii rusinoita pullasta

      Korni näytösesitelmä menossa kaupunginvaltuustossa. Juhlia ei ole kokouksista tiedossa muilla, kuin monipuolue paikalli
      Pyhäjärvi
      88
      901
    Aihe