Seuraavanlainen ongelma olisi ja itse en ole saanut tätä vielä onnistumaan.
Sain excel-tiedostona mittausdataa, jossa ensimmäisessä sarakkeessa on päivämäärä ja aika ja toisessa mittausarvo 10 minuutin välein:
http://cid-5cde060cd65c2e75.photos.live.com/self.aspx/Excel^_ongelma/excel^_lista.JPG
Saisiko excelillä tehtyä jotenkin niin, että tosta aika sarakkeesta se etsisi saman tunnin tiedot ja laskisi siitä kohdasta sen tunnin mittausarvojen keskiarvon. Eli tosta ylemmästä syntyisi taulukko tuntien tarkkuudella:
http://cid-5cde060cd65c2e75.photos.live.com/self.aspx/Excel^_ongelma/excel.JPG
Näin saisin taulukon pienentymään 6 kertaisesti ja olisi helpompi seurata, kun tarvisin vaan tunnittaiset arvot. Tällä hetkellä tossa on noin 20 000 mittausta... Lisähaastetta aiheuttaa, kun sieltä täältä puuttuu joitain 10 minuuttisia, joissain tunneissa mittauksia on 6 ja joissain 3.
Onko tällänen edes mahdollista excelissä? Kiitoksia jo etukäteen!
Sain excel-tiedostona mittausdataa, jossa ensimmäisessä sarakkeessa on päivämäärä ja aika ja toisessa mittausarvo 10 minuutin välein:
http://cid-5cde060cd65c2e75.photos.live.com/self.aspx/Excel^_ongelma/excel^_lista.JPG
Saisiko excelillä tehtyä jotenkin niin, että tosta aika sarakkeesta se etsisi saman tunnin tiedot ja laskisi siitä kohdasta sen tunnin mittausarvojen keskiarvon. Eli tosta ylemmästä syntyisi taulukko tuntien tarkkuudella:
http://cid-5cde060cd65c2e75.photos.live.com/self.aspx/Excel^_ongelma/excel.JPG
Näin saisin taulukon pienentymään 6 kertaisesti ja olisi helpompi seurata, kun tarvisin vaan tunnittaiset arvot. Tällä hetkellä tossa on noin 20 000 mittausta... Lisähaastetta aiheuttaa, kun sieltä täältä puuttuu joitain 10 minuuttisia, joissain tunneissa mittauksia on 6 ja joissain 3.
Onko tällänen edes mahdollista excelissä? Kiitoksia jo etukäteen!
Vastaukset 28
Vanhimmat
lisää uuden taulukon "Uusi" ja tekee siellä tarvittavat jutskat...
moduuliin...
Option Explicit
Sub Keskiarvo()
Dim Originaali As Range
Dim vika As Long
Dim i As Long
Dim lkm As Long
Dim solu As Range
On Error Resume Next
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set Originaali = Columns("A:B")
Worksheets("Uusi").Delete
On Error GoTo 0
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Uusi"
Originaali.Copy Range("A1")
Columns("A:B").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Rows("1:2").Insert
vika = Range("A65536").End(xlUp).Row
lkm = 2
For i = vika To 3 Step -1
If Format(Range("A" & i), "hh") = Format(Range("A" & i - 1), "hh") Then
Range("A" & i).Offset(-1, 1) = Range("A" & i).Offset(-1, 1) Range("A" & i).Offset(0, 1)
Range("A" & i).Offset(-1, 2) = Range("A" & i - 1).Offset(-1, 2) lkm
lkm = lkm 1
Range("A" & i).EntireRow.Delete
Else
lkm = 2
End If
Next
vika = Range("B65536").End(xlUp).Row
For Each solu In Range("B3:B" & vika)
solu = solu / solu.Offset(0, 1)
Next
Range("A:A").NumberFormat = "dd/yy/mm hh"
Range("B:B").NumberFormat = "0.00"
Range("C:C").Delete
Range("B2") = "Keskiarvo"
ActiveCell.Columns("A:B").EntireColumn.EntireColumn.AutoFit
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Keep EXCELing
@Kunde
Melkein toimi jo todella hyvin kerrasta, mutta pieni bugi tosta löyty. Joissain tunneissa mittauksia olikin vaan yksi ja siinä kohtaa toi sekoaa. Sen jälkeen se laskee vaan tuntien arvot yhteen, eikä ota keskiarvoa. Samoin jos taulukon alussa on jotain tekstiä niin siitäkään se ei tykkää vaan tekee heti noin.
Eli kuvina lähtötilanne:
http://cid-5cde060cd65c2e75.photos.live.com/self.aspx/Excel^_ongelma/excel^_bugi^_lahtotilanne.JPG
Ja sit kun ton on ajanut läpi:
http://cid-5cde060cd65c2e75.photos.live.com/self.aspx/Excel^_ongelma/excel^_bugi.JPG
Jos ton mittauskohdan poistaa, niin sit se toimii aina seuraavaan tollaseen kohtaan asti.
no korjattu nyt, mutta tekstistä en oo varma kun ei oo tietoa miten se on tiedostossa...
mutta eipähän toi laske kuin lukuja nyt sitteen...
Option Explicit
Sub Keskiarvo()
Dim Originaali As Range
Dim vika As Long
Dim i As Long
Dim lkm As Long
Dim solu As Range
On Error Resume Next
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set Originaali = Columns("A:B")
Worksheets("Uusi").Delete
On Error GoTo 0
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Uusi"
Originaali.Copy Range("A1")
Columns("A:B").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Rows("1:2").Insert
vika = Range("A65536").End(xlUp).Row
lkm = 1
For i = vika To 3 Step -1
If Format(Range("A" & i), "hh") = Format(Range("A" & i - 1), "hh") Then
Range("A" & i).Offset(-1, 1) = Range("A" & i).Offset(-1, 1) Range("A" & i).Offset(0, 1)
Range("A" & i).Offset(-1, 2) = Range("A" & i - 1).Offset(-1, 2) lkm 1
lkm = lkm 1
Range("A" & i).EntireRow.Delete
Else
If lkm = 1 Then
Range("A" & i).Offset(-1, 1) = Range("A" & i).Offset(-1, 1) Range("A" & i).Offset(0, 1)
Range("A" & i).Offset(0, 2) = 1
End If
lkm = 1
End If
Next
vika = Range("B65536").End(xlUp).Row
For Each solu In Range("B3:B" & vika)
If IsNumeric(solu) Then
solu = solu / solu.Offset(0, 1)
End If
Next
Range("A:A").NumberFormat = "dd/yy/mm hh"
Range("B:B").NumberFormat = "0.00"
Range("C:C").Delete
Range("B2") = "Keskiarvo"
ActiveCell.Columns("A:B").EntireColumn.EntireColumn.AutoFit
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Keep EXCELing
@Kunde
Tämä toimii täydellisesti, kiitoksia!
Semmonen jatkokysymys tuli, kun nyt on pitkä lista päivämääriä, kellonaikoja ja mittaustuloksia, saisiko ne jotenkin jaoteltua viikottaisiks?
Eli lähtötilanteessa nyt on toi keskiarvotaulukko:
http://cid-5cde060cd65c2e75.photos.live.com/self.aspx/Excel^_ongelma/excel.JPG
Saisiko tosta tehtyä jotenkin taulukon, jossa sarakkeella kuluisi aika ma-su joka päivä 0-23 ja rivillä menisi viikot 1-. Eli kuvana:
https://skydrive.live.com/?sc=photos#cid=5CDE060CD65C2E75&id=5CDE060CD65C2E75!192&sc=photos
Jos vaan mahdollista niin päivien väliin voisi jättää rivin tai kaks tyhjää, että siinä saisi laskeskeltua päiväkohtaisesti noita arvoja.
aika cool...
lisää taulukko Koonti (oishan sen voinut koodillakin hoitaa, mutta pikaisesti näin nyt- nimeä sopivaksi tarvittaessa)
jos enemmän tyhjiä rivejä tartte niin muuta lukua isommaksi
ActiveCell.Offset(26, 0).Select
moduuliin...
Option Explicit
Sub Teetaulukko()
Dim vika As Long
Dim solu As Range
With Worksheets("Koonti")
.Activate
.Cells = ""
.Range("B1") = "viikko:"
.Range("B2") = "klo"
.Range("C1").Formula = "1"
LisääSarjat Range("C1"), 1, 52
LisääSarjat2 Range("A3")
End With
Worksheets("Taul1").Activate
vika = Range("A65536").End(xlUp).Row
For Each solu In Range("A3:A" & vika)
Worksheets("Koonti").Range(UCase(Format(solu, "dddd"))).Cells(Format(solu, "hh") 1, Format(solu, "ww") 2) = solu.Offset(0, 1)
Next
Worksheets("Koonti").Cells.EntireColumn.AutoFit
End Sub
Sub LisääSarjat(solu As Range, Aloitus As Long, Määrä As Long)
With Worksheets("Koonti")
solu.Formula = Aloitus
solu.AutoFill Destination:=Range(solu.Address & ":" & solu.Offset(0, Määrä).Address), Type:=xlFillSeries
End With
End Sub
Sub LisääSarjat2(solu As Range)
Dim i As Long
With Worksheets("Koonti")
solu.Select
For i = 1 To 7
ActiveCell = UCase(WeekdayName(i))
ActiveCell.Offset(0, 1).Formula = "0"
ActiveCell.Offset(0, 1).AutoFill Destination:=Range(ActiveCell.Offset(0, 1).Address & ":" & ActiveCell.Offset(23, 1).Address), Type:=xlFillSeries
ActiveWorkbook.Names.Add Name:=ActiveCell, RefersTo:=Range(ActiveCell.Address & ":" & ActiveCell.Offset(23, 54).Address)
ActiveCell.Offset(26, 0).Select
Next
End With
End Sub
Keep EXCELing
@Kunde
Lähellä, lähellä... Pientä ongelmaa tossa viä on, kun sunnuntait menee yden sarakkeen jäljessä ja ensimmäinen sunnuntai on tyhjää täynnä. Sit tossa viime vuosi menee viikolle 53 ja kalenterin mukaan oli 52 viikkoa. Sen huomasin, että toi alkaa lajittelemaan dataa viikon myöhässä, viikolta 40, kun sen pitäisi olla 39. Ehkä on helpompaa jos laitan ton excel tiedoston mukaan:
https://skydrive.live.com/P.mvc#!/view.aspx/Excel^_ongelma/Taulukko.xlsm?cid=5cde060cd65c2e75&sc=photos
niinpä niin.
Excelhän laskee viikot väärin-eli ei ISO standardin mukaisesti .... ;-)
Pitänee aamulla fiksata sulle ISO standardin mukainen koodi. En jaksa nyt ettiä sitä koneeltani, mutta piece of cake se on. Muuttaa vaan ton viikkolaskurin
löyinkin sen hetimiten, joten tossapa korjattuna nyt ISO standardin mukaiseksi...
Option Explicit
Sub Teetaulukko()
Dim vika As Long
Dim solu As Range
Dim viikko As Long
With Worksheets("Koonti")
.Activate
.Cells = ""
.Range("B1") = "viikko:"
.Range("B2") = "klo"
.Range("C1").Formula = "1"
LisääSarjat Range("C1"), 1, 52
LisääSarjat2 Range("A3")
End With
Worksheets("Taul1").Activate
vika = Range("A65536").End(xlUp).Row
For Each solu In Range("A3:A" & vika)
viikko = ViikkoISO(CDate(solu))
Worksheets("Koonti").Range(UCase(Format(solu, "dddd"))).Cells(Format(solu, "hh") 1, viikko 2) = solu.Offset(0, 1)
Next
Worksheets("Koonti").Cells.EntireColumn.AutoFit
End Sub
Sub LisääSarjat(solu As Range, Aloitus As Long, Määrä As Long)
With Worksheets("Koonti")
solu.Formula = Aloitus
solu.AutoFill Destination:=Range(solu.Address & ":" & solu.Offset(0, Määrä).Address), Type:=xlFillSeries
End With
End Sub
Sub LisääSarjat2(solu As Range)
Dim i As Long
With Worksheets("Koonti")
solu.Select
For i = 1 To 7
ActiveCell = UCase(WeekdayName(i))
ActiveCell.Offset(0, 1).Formula = "0"
ActiveCell.Offset(0, 1).AutoFill Destination:=Range(ActiveCell.Offset(0, 1).Address & ":" & ActiveCell.Offset(23, 1).Address), Type:=xlFillSeries
ActiveWorkbook.Names.Add Name:=ActiveCell, RefersTo:=Range(ActiveCell.Address & ":" & ActiveCell.Offset(23, 54).Address)
ActiveCell.Offset(26, 0).Select
Next
End With
End Sub
Public Function ViikkoISO(Päiväys As Date) As Long
Dim D As Date
D = DateSerial(Year(Päiväys - Weekday(Päiväys - 1) 4), 1, 3)
ViikkoISO = Int((Päiväys - D Weekday(D) 5) / 7)
End Function
Keep EXCELing
@Kunde
Kiitoksia taas, tämä toimii todella hyvin!
Hyvää ei kannata korjata, mutta kunden ansiokkaiden makrojen lisäksi asian voi ratkaista pivot-taulukolla. kun vain lisää aikaleimasta lasketut apusarakkeet TUNTI(..) ja VIIKONPÄIVÄ(..) ja niiden perusteella tekee pivot-keskiarvot...
uteliaisuuttani kyselen voisitko lähettää mulle esimerkin tosta mailiini (versio Excel 2003) [email protected].
alkutilanne siis tää
https://skydrive.live.com/?cid=5cde060cd65c2e75&sc=photos&id=5CDE060CD65C2E75!189
ja tommonen siitä pitäs tulla
https://skydrive.live.com/P.mvc#!/view.aspx/Excel^_ongelma/Taulukko.xlsm?cid=5cde060cd65c2e75&sc=photos
Vielä pitää palata tän aiheen tiimoilta asiaan. Noilla edellisillä koodeilla oon jo päässyt todella pitkälle ja kiitoksia siitä, mutta nyt tuli eteen sellanen tiedosto, jossa on mitattu yhden huoneen läsnäolotietoja: 1 = tilassa liikettä, 0 = tilassa ei liikettä (eli vaihtelevat vuorotellen). Nyt tämän pitäisi saada samanlaiseen tunnittaiseen muotoon kuin noi edelliset.
Ongelmana on, että noiden tilojen muutosten ajat on vaan rekisteröity, ne ei ole säännönmukaisia ja ne voivat olla mitä tahansa esim. 5 minuutin - 1 päivän välillä:
https://skydrive.live.com/#cid=5CDE060CD65C2E75&id=5CDE060CD65C2E75!196
Mietin, onnistuisiko esimerkiksi semmonen, että kaikki 15 minuuttia pienemmän läsnäolotiedot poistetaan ja loput ajat pyöristetään puolen tunnin tarkkuuteen. Tämän jälkeen noi arvot siirrettäisiin tunnittaiseen taulukkoon, taulukkoon syötettäisiin arvoa 1 kunnes tulee arvo 0 ja päinvastoin. Jos tämä vaihtuu puolen tunnin kohdalla, syötetään arvoksi 0,5. Eli tulisi tällainen taulukko:
https://skydrive.live.com/#cid=5CDE060CD65C2E75&id=5CDE060CD65C2E75!195
Ja lopulta tolla jälkimmäisellä koodilla:
https://skydrive.live.com/#cid=5CDE060CD65C2E75&id=5CDE060CD65C2E75!197
En tiä sit kuinka vaikee tällänen on toteuttaa ja onnistuu. Tässä vielä excel-tiedosto (jossa vain noin 800 mittausta, koko tiedossa 10 000 mittausta...)
https://skydrive.live.com/view.aspx?cid=5CDE060CD65C2E75&resid=5CDE060CD65C2E75!198
Viikon verran oon nyt pähkäilly miten tämä onnistuisi helpoiten ja parempaa en oo keksinyt.
Mikähän muuten tossa 7.6.2011 postin koodissa on, kun testasin sitä näihin mittauksiin ja joidenkin tuntien keskiarvoksi sain muun muassa 2 tai 1,5 vaikka kaikki mittaukset on 1 tai 0?
joku ristiriita mallitiedostossa tai sitten en ymmärrä juttua. Nyt siis pyöristää tunnit ylöspäin 30 min väleille ja jos muutos puolikkaalla tunnilla silloin 0,5 muutoin voimassa oleva 0 tai 1
nyt mallissasi on kuitenkin loppupäivällä pelkkää ykköstä vaikka muutoksia tapahtuu ja vieläpä puolikkaalle tunnille?
vaatii parempia ohjeita
tossa nyt koodin pätkä mikä muuttaa ajat ja poistaa alle 15 min ajat
hipsujen paikkoja vaihtamalla voit kokeilla aikojen pyöristyksiä alas tai ylöspäin tai lähimpään 30 min...
nythän siinä pyöristyksen jälkeen voi olla sekä 0 tai 1 samalla ajalla ja mitäs sitten tapahtuu???
originaalikoodihan laskee keskiarvojatunneille, joten tulos on tietenkin väärä
Sub Keskiarvo()
Dim Originaali As Range
Dim vika As Long
Dim i As Long
Dim lkm As Long
Dim solu As Range
Dim alue As Range
On Error Resume Next
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set Originaali = Columns("A:B")
Worksheets("Uusi").Delete
On Error GoTo 0
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Uusi"
Originaali.Copy Range("A1")
Columns("A:B").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Columns("C:C").NumberFormat = "[hh]:mm:ss"
vika = Range("B65536").End(xlUp).Row
If Range("B1") = 0 Then
For i = 2 To vika Step 2
Range("B" & i).Offset(0, 1) = Range("A" & i 1) - Range("A" & i)
Next
Else
For i = 1 To vika Step 2
Range("B" & i).Offset(0, 1) = Range("A" & i 1) - Range("A" & i)
Next
End If
Columns("A:C").Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("C1").Select
'1/96 =15 min (tunti 1/24 vrk ja 1/4 osa siitä)
Do Until ActiveCell > 1 / 96
ActiveCell.Offset(1, 0).Select
Loop
Range("A1:A" & ActiveCell.Row - 1).EntireRow.Delete
Columns("A:C").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
vika = Range("A65536").End(xlUp).Row
For Each solu In Range("A1:A" & vika)
'vba funktio pyöristää lähinpään alas tai ylöspäin
'solu = Mround(solu, 1 / 48)
'excelin oma pyöristää ylöspäin
solu = Application.WorksheetFunction.Ceiling(solu, 1 / 48)
'excelin oma pyöristää alaspäin
'solu = Application.WorksheetFunction.Floor(solu, 1 / 48)
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Eli siis tossa tiedostossa läsnäolo alkaa siitä ajanhetkestä, kun on mitattu toi arvo 1. Se jatkuu niin kauan kunnes tulee mittaus 0 (poissa) ja sit 0 jatkuu taas niin kauan kun tulee 1.
Tolla 0,5 tarkoitin, että tunnin aikana puolet on paikalla ja puolet poissa ja puolen tunnin kohdassa vaihtuu 1->0 tai 0->1. Liian pienet ajat haluan poistaa juuri sen takia, ettei kävisi niin, että moni pyöristyisi samalle puolituntiselle. Huomasin, että jos haluaa esim. jonkun 15 minuutin poissa olon poistaa, niin pitää poistaa mittaus, jossa arvo menee 0 ja mittaus, jossa toi muuttuu takaisin 1.
En oo aivan varma onko toi malli oikein, mutta toi 0,5 tarkoittaa, että huoneesta on lähdetty pois, mutta poissaolo on vienyt tunnista vain puolet ja tultu takaisin.
Jos keksit paremman tavan millä tehdä, kaikki käy. Laskennan tarkkuudella ei ole väliä, mutta mietin vaan miten tän saisi tehtyä. Jos tämä onnistuu, niin sit tota ei varmaan oo vaikea muuttaa esim. 15 minuutin tarkkuudelle. Alun perin mietin myös vaihtoehtoa, että jos toi tila vaihtelee monta kertaa tunnin aikana niin saisi laskettua tunnin aikana kaikki läsnäolo minuutit yhteen ja vertaisi tätä 60 minuuttiin. Siitä saisi tarkasti, minkä osan on ollut poissa ja minkä paikalla, mutta sen koodaaminen saattaa mennä sen verran vaikeaksi, etten uskaltanut ehdottaa :)
Tosta siis tarvitsisin vaan tollaisen tunnittaisen vuositaulukon, jonka oon saanut muista tehtyä tolla 22.6. koodilla. Pitäisi saada vertailtua tätä muihin mittauksiin.
laskee nyt minuutin tarkkuudella läsnäolot - kiireiltäni en ehtinyt testaamaan paljoakaan, mutta näyttäis menevän oikein
ei saanut lähetetttyä kaikkea koodia(sisältö liian pikä...), mutta ne muut koodinpätkät ei oo muuttunut
Option Explicit
Sub Keskiarvo()
Dim Originaali As Range
Dim vika As Long
Dim i As Long
Dim lkm As Long
Dim solu As Range
Dim alue As Range
Dim Löydetty As Range
On Error Resume Next
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set Originaali = Columns("A:B")
Worksheets("Uusi").Delete
On Error GoTo 0
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Uusi"
Originaali.Copy Range("A1")
Columns("A:B").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'haetaan läsnäoloajat C sarakkeeseen
Columns("C:C").NumberFormat = "[hh]:mm:ss"
vika = Range("B65536").End(xlUp).Row
If Range("B1") = 0 Then
For i = 2 To vika Step 2
Range("B" & i).Offset(0, 1) = Range("A" & i 1) - Range("A" & i)
Next
Else
For i = 1 To vika Step 2
Range("B" & i).Offset(0, 1) = Range("A" & i 1) - Range("A" & i)
Next
End If
'lisätään ajat taulukkoon
Teetaulukko
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Sub Teetaulukko()
Dim vika As Long
Dim solu As Range
Dim i As Long
Dim j As Long
Dim viikko As Long
With Worksheets("Koonti")
.Activate
.Cells = ""
.Range("B1") = "viikko:"
.Range("B2") = "klo"
.Range("C1").Formula = "1"
LisääSarjat Range("C1"), 1, 52
LisääSarjat2 Range("A3")
End With
Worksheets("Uusi").Activate
vika = Range("A65536").End(xlUp).Row
For Each solu In Range("A1:A" & vika)
viikko = ViikkoISO(CDate(solu))
If solu.Offset(0, 1) = 1 Then
solu.Offset(0, 3) = Format(solu solu.Offset(0, 2), "yyyy-mm-dd hh:mm:ss")
solu.Offset(0, 4) = Format(solu, "hh")
solu.Offset(0, 5) = Format(solu solu.Offset(0, 2), "hh")
solu.Offset(0, 6) = Minute(solu)
solu.Offset(0, 7) = Minute(solu.Offset(0, 3))
If solu.Offset(0, 5) < solu.Offset(0, 4) Then solu.Offset(0, 5) = solu.Offset(0, 5) 24
'siirretään
'sama tunti
If solu.Offset(0, 4) = solu.Offset(0, 5) Then
Worksheets("Koonti").Range(UCase(Format(solu, "dddd"))).Cells(Format(solu, "hh") 1, viikko 2).NumberFormat = "General"
Worksheets("Koonti").Range(UCase(Format(solu, "dddd"))).Cells(Format(solu, "hh") 1, viikko 2) = Worksheets("Koonti").Range(UCase(Format(solu, "dddd"))).Cells(Format(solu, "hh") 1, viikko 2) CDbl(Minute(solu.Offset(0, 2)))
'tunnin ero
Else
If solu.Offset(0, 5) - solu.Offset(0, 4) = 1 Then
Worksheets("Koonti").Range(UCase(Format(solu, "dddd"))).Cells(Format(solu, "hh") 1, viikko 2) = Worksheets("Koonti").Range(UCase(Format(solu, "dddd"))).Cells(Format(solu, "hh") 1, viikko 2) CDbl(60 - Minute(solu))
Worksheets("Koonti").Range(UCase(Format(solu.Offset(0, 3), "dddd"))).Cells(Format(solu.Offset(0, 3), "hh") 1, viikko 2) = Worksheets("Koonti").Range(UCase(Format(solu.Offset(0, 3), "dddd"))).Cells(Format(solu.Offset(0, 3), "hh") 1, viikko 2) CDbl(Minute(solu.Offset(0, 3)))
'usean tunnin ero
Else
For i = solu.Offset(0, 4) To solu.Offset(0, 5)
If i = solu.Offset(0, 4) Then
Worksheets("Koonti").Range(UCase(Format(solu, "dddd"))).Cells(Format(solu, "hh") 1, viikko 2) = Worksheets("Koonti").Range(UCase(Format(solu, "dddd"))).Cells(Format(solu, "hh") 1, viikko 2) CDbl(60 - Minute(solu))
Else
If i = solu.Offset(0, 5) Then
Worksheets("Koonti").Range(UCase(Format(solu.Offset(1, 0), "dddd"))).Cells(Format(solu.Offset(1, 0), "hh") 1, viikko 2) = Worksheets("Koonti").Range(UCase(Format(solu.Offset(1, 0), "dddd"))).Cells(Format(solu.Offset(1, 0), "hh") 1, viikko 2) Minute(solu.Offset(1, 0))
' vrk vaihtuu
Else
If i > 23 Then
j = i - 24
Worksheets("Koonti").Range(UCase(Format(solu.Offset(1, 0), "dddd"))).Cells(j 1, viikko 2) = 60
Else
j = i
Worksheets("Koonti").Range(UCase(Format(solu, "dddd"))).Cells(j 1, viikko 2) = 60
End If
End If
End If
Next
End If
End If
End If
Next
Worksheets("Koonti").Cells.NumberFormat = "General"
Worksheets("Koonti").Cells.EntireColumn.AutoFit
Worksheets("Koonti").Activate
End Sub
Keep EXCELing
@Kunde
Pieni bugi löyty, mutta muuten toi toimii todella hyvin. Ongelma ei ole koodissa, vaan tossa tiedostossa. Mittauksissa on ollu joku häiriö ja muutamassa kohtaa on 1 (läsnäolo) kaks kertaa peräkkäin. Tämän kohdan jälkeen toi syöttää koko loppu ajalle vain 0 (poissa). Jos toi sama tila toistuu noin peräkkäin, saisiko ton koodin jättämään ton huomioimatta?
Kuvana:
https://blufiles.storage.live.com/y1pahw0oY10sQd7vFD-MmjsLS5NkTkVblJoNhVv1FHAwYjAC7eYS8pUJc1cqj8cgHcWQ7HvH4lmr4M/lasnaolo_bugi.jpg?psid=1
Ja toi kohta excelissä:
https://skydrive.live.com/view.aspx?cid=5CDE060CD65C2E75&resid=5CDE060CD65C2E75!201
Pitää vielä toivoa tohon muutama ominaisuus. Miten ton "koonti" taulukon saisi tehtyä automaattisesti? Se meinaa aina jäädä ja toi heittää erroria. Ja nyt toi koodi jättää poissaolot tyhjäksi, saisiko niihin paikkoihin sen syöttämään arvon 0? Mihin kohtaan koodissa tulisi lisätä / 60 jos haluaisin noi minuutit muuttaa tunneiksi?
Kiitoksia taas paljon tästä, helpottaa huomattavasti, kun tollasia tiedostoja on tossa useita...
Jos toi koodi menee liian pitkäksi, ettei täällä pysty lähettämään niin voisitko lähettää sen osoitteeseen t4p54 ( at ) hotmail.com
lähetä mulle mallitiesoto siitä missä se bugi esiintyy
[email protected]
muutokset
Sub Teetaulukko()
Dim vika As Long
Dim solu As Range
Dim i As Long
Dim j As Long
Dim viikko As Long
With Worksheets("Koonti")
.Activate
.Cells = ""
.Range("B1") = "viikko:"
.Range("B2") = "klo"
.Range("C1").Formula = "1"
LisääSarjat Range("C1"), 1, 52
LisääSarjat2 Range("A3")
End With
Worksheets("Uusi").Activate
vika = Range("A65536").End(xlUp).Row
For Each solu In Range("A1:A" & vika)
viikko = ViikkoISO(CDate(solu))
If solu.Offset(0, 1) = 1 Then
solu.Offset(0, 3) = Format(solu solu.Offset(0, 2), "yyyy-mm-dd hh:mm:ss")
solu.Offset(0, 4) = Format(solu, "hh")
solu.Offset(0, 5) = Format(solu solu.Offset(0, 2), "hh")
solu.Offset(0, 6) = Minute(solu)
solu.Offset(0, 7) = Minute(solu.Offset(0, 3))
If solu.Offset(0, 5) < solu.Offset(0, 4) Then solu.Offset(0, 5) = solu.Offset(0, 5) 24
'siirretään
'sama tunti
If solu.Offset(0, 4) = solu.Offset(0, 5) Then
'näyttää tunnit 1/100 tarkkuudella
Worksheets("Koonti").Range(UCase(Format(solu, "dddd"))).Cells(Format(solu, "hh") 1, viikko 2).NumberFormat = "0.00"
Worksheets("Koonti").Range(UCase(Format(solu, "dddd"))).Cells(Format(solu, "hh") 1, viikko 2) = (Worksheets("Koonti").Range(UCase(Format(solu, "dddd"))).Cells(Format(solu, "hh") 1, viikko 2) CDbl(Minute(solu.Offset(0, 2)))) / 60
'tunnin ero
Else
If solu.Offset(0, 5) - solu.Offset(0, 4) = 1 Then
Worksheets("Koonti").Range(UCase(Format(solu, "dddd"))).Cells(Format(solu, "hh") 1, viikko 2).NumberFormat = "0.00"
Worksheets("Koonti").Range(UCase(Format(solu, "dddd"))).Cells(Format(solu, "hh") 1, viikko 2) = (Worksheets("Koonti").Range(UCase(Format(solu, "dddd"))).Cells(Format(solu, "hh") 1, viikko 2) CDbl(60 - Minute(solu))) / 60
Worksheets("Koonti").Range(UCase(Format(solu.Offset(0, 3), "dddd"))).Cells(Format(solu.Offset(0, 3), "hh") 1, viikko 2).NumberFormat = "0.00"
Worksheets("Koonti").Range(UCase(Format(solu.Offset(0, 3), "dddd"))).Cells(Format(solu.Offset(0, 3), "hh") 1, viikko 2) = (Worksheets("Koonti").Range(UCase(Format(solu.Offset(0, 3), "dddd"))).Cells(Format(solu.Offset(0, 3), "hh") 1, viikko 2) CDbl(Minute(solu.Offset(0, 3)))) / 60
'usean tunnin ero
Else
For i = solu.Offset(0, 4) To solu.Offset(0, 5)
If i = solu.Offset(0, 4) Then
Worksheets("Koonti").Range(UCase(Format(solu, "dddd"))).Cells(Format(solu, "hh") 1, viikko 2).NumberFormat = "0.00"
Worksheets("Koonti").Range(UCase(Format(solu, "dddd"))).Cells(Format(solu, "hh") 1, viikko 2) = (Worksheets("Koonti").Range(UCase(Format(solu, "dddd"))).Cells(Format(solu, "hh") 1, viikko 2) CDbl(60 - Minute(solu))) / 60
Else
If i = solu.Offset(0, 5) Then
Worksheets("Koonti").Range(UCase(Format(solu.Offset(1, 0), "dddd"))).Cells(Format(solu.Offset(1, 0), "hh") 1, viikko 2).NumberFormat = "0.00"
Worksheets("Koonti").Range(UCase(Format(solu.Offset(1, 0), "dddd"))).Cells(Format(solu.Offset(1, 0), "hh") 1, viikko 2) = (Worksheets("Koonti").Range(UCase(Format(solu.Offset(1, 0), "dddd"))).Cells(Format(solu.Offset(1, 0), "hh") 1, viikko 2) Minute(solu.Offset(1, 0))) / 60
' vrk vaihtuu
Else
If i > 23 Then
j = i - 24
Worksheets("Koonti").Range(UCase(Format(solu.Offset(1, 0), "dddd"))).Cells(j 1, viikko 2) = 1
Else
j = i
Worksheets("Koonti").Range(UCase(Format(solu, "dddd"))).Cells(j 1, viikko 2) = 1
End If
End If
End If
Next
End If
End If
End If
Next
Worksheets("Koonti").Cells.EntireColumn.AutoFit
Worksheets("Koonti").Activate
End Sub
Sub LisääSarjat2(solu As Range)
Dim i As Long
With Worksheets("Koonti")
solu.Select
For i = 1 To 7
ActiveCell = UCase(WeekdayName(i))
ActiveCell.Offset(0, 1).Formula = "0"
ActiveCell.Offset(0, 1).AutoFill Destination:=Range(ActiveCell.Offset(0, 1).Address & ":" & ActiveCell.Offset(23, 1).Address), Type:=xlFillSeries
ActiveWorkbook.Names.Add Name:=ActiveCell, RefersTo:=Range(ActiveCell.Address & ":" & ActiveCell.Offset(23, 54).Address)
Range(ActiveCell) = 0
ActiveCell.Offset(26, 0).Select
Next
End With
End Sub
Vielä pitää palata tähän. Oon opetellut tota VBA-koodia, että ymmärrän mitä tossa tehdään ja pienet tarvittavat muutokset ja lisäykset oon nyt saanut tehtyä tuohon ensimmäiseen minuuttien tarkkuudella laskevaan koodiin. Mutta nyt tuli semmonen isompi bugi eteen, että tarvitsisin apua.
Joissain tapauksissa arvo 1(läsnäolo) jatkuu monia päiviä, parhaimmillaan päälle 1000 tuntia (2.4.2011 9:12:57 (vk 13) - 17.5.2011 9:53:38 (vk 29)). Nyt koodi jättää huomiotta noi välissä olevat päivät ja jättää ne kohdat tyhjiksi. Viimeisen päivän tunnit se merkkaa, mutta nekin ilmeisesti viikolle 46 vaikka sen pitäisi olla 29.
Lisäksi jos aika on lyhyempi ja läsnäolo (1) kuitenkin jatkuu seuraavaan viikkoon (esim. su 23.1.2011 19:40:11 - ma 24.1.2011 10:08:34), viikko ei vaihdu ollenkaan vaan noi maanantain arvot se lisää samalle viikolle.
Voisiko joku auttaa mahdollisimman pian ongelmien kanssa ja mitä lisäyksiä koodiin pitäisi tehdä? Tarvisin tätä heti ens viikon alussa.
Anyone?
korjattavissahan noi olisi kohtuu helposti, nutta aikani ei nyt riitä kun työt haittaa harrastuksia...
Kehittyneissä taulukkolaskentaohjelmissa, kuten OpenOffice.orgin Calcissa, tuollaiseen ei tavita makroilla korjattua toimintaa, vaan sen voi tehdä seuraavasti:
1) Lisätään otsikkorivi, johon tulee sarakkeille selitteet, kuten "aikaleima" ja "arvo"
2) Muotoillaan aikaleiman sarake (A) sopivaan päivämäärä muotoon, tässä PP.KK.VV TT
3) Valitaan sarakkeet (A "aikaleima" ja B "arvo")
4) Tiedot - Välisummat -valintaikkunassa valitaan ryhmittely aikaleiman mukaan, välisumma arvoista ja käytetään funktiota Keskiarvo.
Jos ryhmittely pitää tehdä jollakin sellaisella periaatteella, että se vaatii funktion, niin lasketaan eri sarakkeeseen (C) tuo ryhmittelytekijä ja toimitaan sitten vastaavasti B ja C sarakkeilla.
Mahdollisesti tämän saa tehtyä Excelissäkin, mutta OpenOffice.org on ilmainen, joten ei maksa mitään tehdä sillä ja tallentaa sitten Excel-muotoon.
Käsittämättömän hieno ilmaisohjelma, jos pystyy pelkistä 0/1 laskemaan paikallaoloajan tunneille huomioiden 15 min poistot yms. ilman makroja.
Jollain on sitten ilmeisesti ollut tarvetta tehdä tommoinenkin oletusfunktio ilmaisohjelmaan. HIENOA
mutta asiaan:
"nythän siinä pyöristyksen jälkeen voi olla sekä 0 tai 1 samalla ajalla ja mitäs sitten tapahtuu???"
Huomasin, että jos haluaa esim. jonkun 15 minuutin poissa olon poistaa, niin pitää poistaa mittaus, jossa arvo menee 0 ja mittaus, jossa toi muuttuu takaisin 1.
selvitys selkeytti asiaa, toisaalta vois sitten kuitenkin laskea paikallaoloajan tunneille sekunnin tarkkuudella ...
Eikö olekin.
Tässä esimerkki, miten tuntikohtaisesti lasketaan arvojen summa 1 (läsnäolo) ja 0 (poissaolo) tapauksille ja tuntikohtainen keskiarvo. Kyseiset funktiot ovat vapaasti valittavissa n. 10 tilastofunktion joukosta ja ryhmittelytasoja on kolme (tässä siis käytössä 2).
http://www.saunalahti.fi/rjaaskel/1/Menu/Julkisetkuvat/Välisumma1.PNG
http://www.saunalahti.fi/rjaaskel/1/Menu/Julkisetkuvat/Välisumma2.PNG
http://www.saunalahti.fi/rjaaskel/1/Menu/Julkisetkuvat/Välisumma3.PNG
Esitystapaa voi järjestellä useammalla tavalla. Tiedostojen nimi on muuten Välisumma1.PNG jne., jos vajaa-aakkosjärjestelmät eivät tunnista noista linkeistä.
"tunti" -sarake on laskennallinen (aikaleimasta), joten siihen saa upotettua jotain rajausta helpottavaa tarvittaessa.
Pivot-taulukkoja on myös ehdotettu, joka on varmaan myös ihan toimiva tapa ilman makroja.
tuttumies:
missäs se tulostaulukko paikallaoloista minuuteissa/tunti?
Tämä on viheliäinen keskustelualusta, mutta ehkäpä Kunde ja aloittaja löytävät tästä jotain. Paikallaan oloajan laskenta ei ilmeisesti tarvitsisi edes välisumman käyttöä, vaan sen saisi ihan aikaerosta?
Tässä kuvitteellinen aikasarja (erot enintään 40 minuuttia, keskimäärin 20 minuuttia) ja satunnainen poissa (0) läsnä(1) tapahtuma (tässä ehkä tulkittava, että päättymiset?). Jos olisi vuorotellen, olisikin yksinkertaisempi.
Sitten lasketaan aikaerot Calcila:
http://www.saunalahti.fi/rjaaskel/1/Menu/Julkisetkuvat/VsummaAika1.PNG
Välisummia varten lajitellaan tunnin ja läsnäolon mukaan:
http://www.saunalahti.fi/rjaaskel/1/Menu/Julkisetkuvat/VsummaAika2.PNG
Ja välisummilla voidaan laskea tunnitaiset luokan 0 ja luokan 1 (poissa-läsnä) aikamäärät. Yli tuntirajan menevät jaksot tulevat tässä päättymistunnin kohdalle, mutta asian saa järjestettyä mieleisekseen.
http://www.saunalahti.fi/rjaaskel/1/Menu/Julkisetkuvat/VsummaAika3.PNG
Täytyy myöntää, että edellinen vastaukseni oli paremminkin aloitusviestiin kuin tuohon välillä esiin tulleeseen tarpeeseen, mutta siitä huolimatta en näe tässä Calcille makroihin erityisempää tarvetta, olipa kyse arvojen viikottaisesta ryhmittelystä tai läsnä/poissaoloajoista.
Hieman ihmetyttää, jos Excel ei pysty samaan?
en usko vieläkään , että ilman makroa onnistuu...
miten välisummat pystyy tekemään merkinnät välillä oleville tunneille, jos se ilmoitetaan kuten esimerkissä eli esim(1) 10:02:30 ja (0)14:45:56. Miten ohjelma voi tosta lukea läsnäolo minuutit eri tunneille ja kirjata siitä ne taulukkoon ilman makroa
eli tälläinen tulos pitäisi saada tosta
klo -läsnäoloaika
10-58
11-60
12-60
13-60
14-45
ihmettelen suunnattomasti jos Calc ton tekee ;-)-
Kunde: Laitoin spostilla mallitiedoston ja vielä muutaman koodiin liittyvän ongelman.
Ei openofficessa muuta vikaa ole, mutta sitä ei löydy kaikilta koneilta ja exceliä on tottunu niin käyttämään. Muutenkin haluan vain nopeesti ajaa koodin monelle tiedostolle, joten nyt yhtäkkiä openofficella kikkailu vaan lisäisi työtä. Tota läsnäoloakin pitäisi saada verrattua aikaisemmilla koodeilla tehtyihin taulukkoihin...