Taulukoiden pyörittelyä

2011-06-07 00:02:38

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!

578

Äänestä

Vastaukset

kunde
2011-06-07 08:25:32
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
tapcap
2011-06-07 11:17:09
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.
kunde
2011-06-07 14:07:00
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
tapcap
2011-06-13 09:22:47
Tämä toimii täydellisesti, kiitoksia!
tapcap
2011-06-21 20:25:32
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.
- kunde
  2011-06-22 07:24:24
  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
tapcap
2011-06-22 10:32:04
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
- kunde
  2011-06-22 15:10:26
  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
- kunde
  2011-06-22 15:46:27
  kunde kirjoitti:
  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
tapcap
2011-06-27 21:34:09
Kiitoksia taas, tämä toimii todella hyvin!
- muan mies
  2011-06-30 22:13:25
  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...
- kunde
  2011-07-01 05:01:22
  muan mies kirjoitti:
  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
tapcap
2011-09-27 00:25:16
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?
- kunde
  2011-09-27 10:56:31
  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
tapcap
2011-09-27 18:42:06
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.
- kunde
  2011-09-28 14:38:50
  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
- tapcap
  2011-09-28 18:37:01
  kunde kirjoitti:
  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
- kunde
  2011-09-29 04:12:10
  tapcap kirjoitti:
  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
- tapcap
  2011-10-30 10:18:47
  kunde kirjoitti:
  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.
- tapcap
  2011-11-11 20:08:14
  tapcap kirjoitti:
  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?
- kunde
  2011-11-12 06:45:00
  tapcap kirjoitti:
  Anyone?
  korjattavissahan noi olisi kohtuu helposti, nutta aikani ei nyt riitä kun työt haittaa harrastuksia...
tuttumies
2011-09-27 20:33:14
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.
kunde
2011-09-28 03:31:57
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 ...
- tuttumies
  2011-09-28 20:24:49
  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.
- kunde
  2011-09-29 04:14:46
  tuttumies kirjoitti:
  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?
tuttumies
2011-09-29 16:37:22
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?
kunde
2011-09-29 17:15:42
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 ;-)-
tapcap
2011-09-30 10:08:29
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...

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

Takaisin ylös

Luetuimmat keskustelut

Anna minulle anteeksi
Anna minulle anteeksi. Minä pyydän.
01.09.2024 14:02Ikävä
152
1878
Kun viimeksi kohtasitte/näitte
Mitä olitte tekemässä? Millainen ympäristö oli? Löydetään toisemme...
01.09.2024 13:13Ikävä
130
1741
Olet kyllä vaarallisen himokas
Luova, kaunis, määrätietoinen, pervo, mielenkiintoinen, kovanaama, naisellinen ja erikoinen.
01.09.2024 00:03Ikävä
102
1497
Anna vielä vähän vihreää valoa
Teen sitten siirtoni, nainen. Tiedän, että olet jo varovaisesti yrittänyt lähestyä, mutta siitä on jo aikaa. Jos tunnet
02.09.2024 00:26Ikävä
17
1203
Mikä on hän on ammatiltaan?
Vai tiedätkö mitä kaivattusi tekee työkseen?
01.09.2024 22:30Ikävä
68
1187
Mitä ajattelit silloin kun
Löysit hänet?
01.09.2024 22:57Ikävä
64
1151
Syksyinen aamuketju suden
Hyvää huomenta ja kaunista syyspäivää. 🌞🍁🍂☕
02.09.2024 08:46Ikävä
219
965
Oletko tutustunut muihin
Samalla tavalla kuin häneen?
01.09.2024 16:40Ikävä
66
787
Uskotko että kohdataan vielä?
Kysymys otsikossa, aloitukseen ei muuta lisättävää.
01.09.2024 18:18Ikävä
45
730
Miksi homous puhuttaa konservatiiveja vuodesta toiseen?
Kysymykseen on vastattukin Kansanlähetyksen osalta: "Miksi sukupuoleen ja seksuaalisuuteen liittyvät asiat ovat konserv
01.09.2024 14:42Luterilaisuus
191
704

Taulukoiden pyörittelyä

Vastaukset

kunde kirjoitti:

muan mies kirjoitti:

kunde kirjoitti:

tapcap kirjoitti:

kunde kirjoitti:

tapcap kirjoitti:

tapcap kirjoitti:

tuttumies kirjoitti:

Luetuimmat keskustelut

Anna minulle anteeksi

Kun viimeksi kohtasitte/näitte

Olet kyllä vaarallisen himokas

Anna vielä vähän vihreää valoa

Mikä on hän on ammatiltaan?

Mitä ajattelit silloin kun

Syksyinen aamuketju suden

Oletko tutustunut muihin

Uskotko että kohdataan vielä?

Miksi homous puhuttaa konservatiiveja vuodesta toiseen?

Järjetöntä väistämisleikkiä sähköpotkulaudoilla

Kuvat! Dannyyn liitetty Helmi Loukasmäki, 22, on puhjennut naisena kukkaan - Some sekoaa: "Sä..."

Suodatinpussin kastelemalla saa parempaa kahvia

Oho! Arja Koriseva paljastaa TTK:n ekasta suorasta lähetyksestä: "On vähän ärsyttävä yhtälö!"

Suojatielle kävely.

red fläkit naisessa

Sehän on vain kymppi kuussa

Juontaja Roope Salminen lataa rajua tekstiä juopottelustaan: "Ei mulla oikeastaan ollut..."

Martina osti talon Lapista

Vihreät uhkaavat kaataa hallituksen syksyllä