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ä ???
Aineisto aikasarjamuotoon?
1
158
Vastaukset
- 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
Suureksi onneksesi on myönnettävä
Että olen nyt sitten mennyt rakastumaan sinuun. Ei tässä mitään, olen kärsivällinen ❤️932129Perusmuotoiset TV-lähetykset loppu
Nyt sanoo useiden HD-muotoistenkin kanavien kohdalla äly-TV, ettei kanava ole käytössä, haluatko poistaa sen? Kanavia1671557YLE Ää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ä741339Euroopan lämpöennätys, 48,8, astetta, on mitattu Italian Sisiliassa
Joko hitaampikin ymmärtää. Se on aivan liikaa. Ilmastonmuutos on totta Euroopassakin.2401237- 731190
Hyvin. Ikävää nainen,
Että vainoat ja stalkkaat miestäni.onko tarkoituksesi ehkä saada meidät eroamaan?no,siinä et tule onnistumaan881106Martina lähdössä Ibizalle
Eikä Eskokaan tiennyt matkasta. Nyt ollaan jännän äärellä.1511051Asiakas iski kaupassa varastelua tehneen kanveesiin.
https://www.iltalehti.fi/kotimaa/a/33a85463-e4d5-45ed-8014-db51fe8079ec Oikein. Näin sitä pitää. Kyllä kaupoissa valtava2531016Katsoin mies itseäni rehellisesti peiliin
Ja pakko on myöntää, että rupsahtanut olen 😆. Niin se ikä saavuttaa meidät kaikki.51936Uskomaton tekninen vaaliliitto poimii rusinoita pullasta
Korni näytösesitelmä menossa kaupunginvaltuustossa. Juhlia ei ole kokouksista tiedossa muilla, kuin monipuolue paikalli88901