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

163

    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. Kalajoen hukkuneet pojat olivat tummaihoisia

      Jälleen kerran, hukkuneet tai heikon uimataidon vuoksi vaaraan joutuneet olivat muita kuin suomalaisia. Turha viisastell
      Maailman menoa
      323
      7075
    2. Kysymys muille miehille

      Onko teille varattu nainen ongelma? Mikään muu naisessa ei töki kun se että hän on varattu. Kamppailen houkutuksen kanss
      Ikävä
      71
      4258
    3. Sinä eräs, pyydän......

      AUTA mua ole kiltti. Ei mun takia vaan.... Miten saan sut kiinni?
      Ikävä
      208
      3155
    4. Kohta katson sun kuvaasi

      ja päästän ajatukseni liitämään. Jo kuvasi näkeminen rauhoittaa, ja pistää hyrräämään vähän muutakin. Ihanan kaunista sa
      Ikävä
      24
      2937
    5. Nimikirjaimet

      Kuka kaipaa ketä 🥰
      Ikävä
      74
      1952
    6. VOI TÄTÄ ILON

      JA ONNEN PÄIVÄÄ 😂
      Tuusniemi
      149
      1781
    7. Ahneus iski Fazeriin, suklaalevy kutistuu 180 grammaan

      Kun mikään ei riitä. Shrinkflaatio. Mitä isot (Marabou) edellä, sitä pienet (Fazer) perässä. Pienikin voi siis olla a
      Maailman menoa
      212
      1746
    8. Jos kaivattusi on perääntynyt lähestyessäsi

      jossain tilanteessa, ymmärrätkö miksi hän saattoi tehdä sen?
      Ikävä
      165
      1560
    9. Minkä asian haluaisit muuttaa kaivatussasi?

      Mikä kaivattusi luonteessa tai ulkonäössä ärsyttää sua?
      Ikävä
      120
      1548
    10. Mies, ajattelemmekohan toisiamme juuri nyt?

      Olet mielessäni, vanhempi mies
      Ikävä
      89
      1438
    Aihe