30. april 2008 - 23:37Der er
9 kommentarer og 1 løsning
Sorter CPR samt dato og kl indenfor 24 timer
Jeg er kørt totalt sur i dette... Jeg har flere regneark som indeholder udtræk med alle blodtransfusioner i et givent år på et givent sygehus. Jeg er interesseret i at vide hvem der har fået mere end 9 transfusioner indenfor 24 timer. Mit ark består bla. af en kolonne med CPR nr.(A), en med dato(D) og en med klokkeslet(E) En transfusion er så en række. Dvs i første omgang har jeg vha betinget formattering fået farvet celler hvor samme cpr optræder mere end ni gange, men da mange får flere transfusioner hen over et helt år, så er jeg nødt til på en måde at få min formattering til at søge på dato og klokkeslet også. Kan det lade sig gøre?? Jeg har brugt det meste af aftenen på at lede efter nogle svar her, men uden held. PLEASE HELP
Ja, de er samlet på et ark. Jeg ved ikke helt hvordan jeg skal forklare det nærmere, og sende eksempler er ikke så smart når der indgår personfølsomme data.
Du har sikkert ret i en sortering på cpr, dato og klokkelslet ville hjælpe, men jeg kan ikke helt hitte ud af at sorter på flere parametre. Hvis det ikke kan lade sig gøre at finde de CPR som optræder mere end ni gange indenfor 24 timer, kan man så findeog få markeret dem som optræder mere end ni gange indenfor +- en dag? Så kan jeg selv kontrollere om det også er indenfor 24 timer. Så er data efterhånden blevet overskuelige at resten kan fikses manuelt.
Sorter først arket med sorteringgsknappen (stigende elelr faldende). Sorter først efter klokkeslættet. Derefter sorterer du igen efter dato og til sidst efter CPR.
Alternativt vælger du Data - Sorter. Sæt så CPR ind som første kriterium, dato som andet og klokkeslæt som tredje inden du sorterer.
Tak so far jkrons Når jeg har gjort som du har beskrevet, kan jeg så få lavet en markering af de CPR nr. som optræder mere end ni gange indenfor + - en dag? Så slipper jeg nemlig for at skulle gøre det manuelt. Der er nemlig stadig masser af CPR nr som ikke er interessante fordi transfusionerne er spredt henover et helt år. Så hvis det på en eller anden måde kan markeres hvis samme CPR optræder mere end ni gange indenfor 24 timer eller alternativt + - en dag. Er det for kryptisk? Det er sikkert simpelt for jer, jeg er absolut ikke nogen haj til excel
Her er et bud: Koden anbringes i Arket for data (højreklik / Vis programkode) Kan udføres via Alt+F8 -kør den viste makro (Data forventes at være sorteres efter: Cpr / Dato / Kl)
Rem Kan justeres efter behov Rem ======================== Const startRæk = 2 'datarække-start, hvis overskrift Const mereEndAntalTrans = 9 'antal blodtransfusioner Rem ========================
Dim aktuelCpr, cpr, dato As Date, kl As Date Dim antalRæk, startCpr, slutCpr, antalCpr Sub optællingBlodTrans() aktuelCpr = "" startCpr = 0 slutCpr = 0 antalCpr = 0
For ræk = startRæk To antalRæk cpr = Cells(ræk, 1) If aktuelCpr = "" Then aktuelCpr = cpr startCpr = ræk End If
If cpr = aktuelCpr Then antalCpr = antalCpr + 1 slutCpr = ræk Else cprBrud
aktuelCpr = cpr startCpr = ræk slutCpr = ræk antalCpr = 1 End If Next ræk
Rem test for sidste række cprBrud
MsgBox ("Optælling afsluttet") End Sub Private Sub cprBrud() Dim tidsstempel As Date, ræk, p24 As Date, antal, til Rem er der brutto mere end "mereEndAntalTrans" If antalCpr > mereEndAntalTrans Then For ræk = startCpr To slutCpr tidsstempel = Format(Cells(ræk, 4), "dd-mm-yy") + " " + Format(Cells(ræk, 5), "hh:mm") Rem beregn "flydende" + 24 timer p24 = DateAdd("h", 24, tidsstempel) antal = antalP24(p24, til) If antal > mereEndAntalTrans Then Range("A" & CStr(ræk) & ":E" & CStr(til)).Select Selection.Interior.ColorIndex = 6 'Gul markering når antal > "mereEndAntalTrans" End If Next ræk End If End Sub Private Function antalP24(p24 As Date, til) Dim tidsstempel As Date antalP24 = 0 til = 0
For ræk = startCpr To slutCpr tidsstempel = Format(Cells(ræk, 4), "dd-mm-yy") + " " + Format(Cells(ræk, 5), "hh:mm") If tidsstempel <= p24 Then antalP24 = antalP24 + 1 til = ræk End If Next ræk End Function
Jeg er så imponeret over i bare sådan kan ryste sådan noget ud af ærmet. Jeg kan dog ikke helt få det til at fungere. Jeg har fået den til at køre VBA'en og den meldte ingen fejl, og markerede også nogle celler, men det virker ikke som om det er helt rigtigt. Jeg kan dog ikke lige gennemskue hvad der er galt. Jeg har været ved at lave et eksempel af mit ark, hvor jeg har klippet ud fra et ark hvor din VBA har kørt og markeret nogle rækker. Jeg har efterfælgende modificeret CPR numrene. Eksemplet indeholder en rigtig samling af markeringer omkring nogle CPR som optræder mere end ni gange indenfor 24 timer og en samling af markeringer hvor det ikke er rigigt. Vil du være interesseret i at kaste et blik på den ved lejlighed? Skal jeg maile den?
Rem VERSION 2 Rem ========= Rem Kan justeres efter behov Rem ======================== Const startRæk = 2 'datarække-start, hvis overskrift Const mereEndAntalTrans = 9 'antal blodtransfusioner Rem ========================
Dim aktuelCpr, cpr, dato As Date, kl As Date Dim antalRæk, startCpr, slutCpr, antalCpr Sub optællingBlodTrans() aktuelCpr = "" startCpr = 0 slutCpr = 0 antalCpr = 0
For ræk = startRæk To antalRæk cpr = Cells(ræk, 1) If aktuelCpr = "" Then aktuelCpr = cpr startCpr = ræk End If
If cpr = aktuelCpr Then antalCpr = antalCpr + 1 slutCpr = ræk Else cprBrud
aktuelCpr = cpr startCpr = ræk slutCpr = ræk antalCpr = 1 End If Next ræk
Rem test for sidste række cprBrud
MsgBox ("Optælling afsluttet") End Sub Private Sub cprBrud() Dim tidsstempel As Date, ræk, p24 As Date, antal, til Rem er der brutto mere end "mereEndAntalTrans" If antalCpr > mereEndAntalTrans Then antal = 0 For ræk = startCpr To slutCpr tidsstempel = Format(Cells(ræk, 4), "dd-mm-yy") + " " + Format(Cells(ræk, 5), "hh:mm") Rem beregn "flydende" + 24 timer p24 = DateAdd("h", 24, tidsstempel) antal = antalP24(p24, til, ræk) If antal > mereEndAntalTrans Then Range("A" & CStr(ræk) & ":E" & CStr(til)).Select Selection.Interior.ColorIndex = 6 'Gul markering når antal > "mereEndAntalTrans" End If Next ræk End If End Sub Private Function antalP24(p24 As Date, til, aktuelRæk) Dim tidsstempel As Date antalP24 = 0 til = 0
For ræk = aktuelRæk To slutCpr tidsstempel = Format(Cells(ræk, 4), "dd-mm-yy") + " " + Format(Cells(ræk, 5), "hh:mm") If tidsstempel <= p24 Then antalP24 = antalP24 + 1 til = ræk End If Next ræk End Function
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
