27. januar 2012 - 10:33Der er
26 kommentarer og 1 løsning
stopur i excel
Hej Eksperter
Jeg er cykeltræner i en cykelkklub, vi afholder enkeltstarts træninger hvor vi så optager deres tider i et excel are. i den forbindelse ville jeg høre om det var muligt at få excel til at have en start og stop knap for hver rytter. Så man slap for at stå med et stopur og tage mellemtider, så ville dette være noget nemmer at excel selv optig tiderne?
Kan det lade sig gøre og er der eventulet en der kan hjælp med at skrive den vba kode??
Jeg fandt følgende fra tidliger spørgsmål men jeg kan ikk finde ud af at bruge setkeys og det skal jo være en bestemt kolonne hvor stopuren skal være:
Public StartTime As Double
Sub SetKeys() Application.OnKey "s", "SetStart" Application.OnKey "m", "SetLapTime" Application.OnKey "f", "FinishTime" End Sub
Sub SetStart() StartTime = Timer Range("a65536").End(xlUp).Offset(1, 0) = 0 End Sub
Sub SetLapTime() Dim Lap As Double Lap = Timer - StartTime Range("a65536").End(xlUp).Offset(1, 0) = Lap End Sub
Sub FinishTime() Call SetLapTime Application.OnKey "s" Application.OnKey "m" Application.OnKey "f" End Sub
Hvis du kører makroen SetKeys, så vil et tryk på tasterne s,m og f give dig starttiden altid =0 , mellemtiden og sluttiden. i tre rækker under hinanden.
Sub SetKeys() Application.OnKey "s", "SetStart" Application.OnKey "m", "SetLapTime" Application.OnKey "f", "FinishTime" End Sub Prøv evt denne variation, som indsætter resultatet i kolonnerne B, C og D
Sub SetStart() StartTime = Timer ActiveSheet.Range("XFD1").End(xlToLeft).Offset(0, 1) = 0 End Sub
Sub SetLapTime() Dim Lap As Double Lap = Timer - StartTime ActiveSheet.Range("XFD1").End(xlToLeft).Offset(0, 1) = Lap End Sub
Sub FinishTime() Call SetLapTime ActiveSheet.Range("XFD1").End(xlToLeft).Select End Sub
Du kan også prøve denne variant, hvor du f.eks i Kolonne A har rytternes Navne i Kolonne B har du starttiden, i Kolonne C mellemtiden og i Kolonne D har du sluttiden.
Når du aktiver Setkeys så skriver den starttiden, mellemtiden og sluttiden i samme række. Når du så taster "s" igen for at starte en ny tidstagning, så skrives resultaterne i næste række.
Public StartTime As Double Public i As Integer
Sub SetKeys() Application.OnKey "s", "SetStart" Application.OnKey "m", "SetLapTime" Application.OnKey "f", "FinishTime" i = 2 End Sub
Sub SetStart() StartTime = Timer ActiveSheet.Range("XFD" & i).End(xlToLeft).Offset(0, 1) = 0 End Sub
Sub SetLapTime() Dim Lap As Double Lap = Timer - StartTime ActiveSheet.Range("XFD" & i).End(xlToLeft).Offset(0, 1) = Lap End Sub
Sub FinishTime() Call SetLapTime ActiveSheet.Range("XFD" & i).End(xlToLeft).Select i = i + 1 End Sub
Jeg kan ikke få et til at fungere...min erfaring med vba er simpelthen for lille tror jeg .. må jeg ikke præve at sende dokumentet til dig for så at se om du kan få det til at fungere ?
Det er stadig ikke hvad jeg søger ... da dette vil forud sætte at alle rytterne kommer ind i kronologist rækkefølge... kan man ikke oprette en knap i excel arket til hver tid der hedder start og stop ?
og sidst men ikke mindst så jeg at så skulle opbygning af tiden faktisk vises tt:mm:ss kan de tlade sig gøre ? for ellers kan secel ikke regne gennemsnits fart for mig
Denne version anvender Excels serienumre til tidstagningen i stedet for Timer funktionen.
Når du skal bruge løsningen i et andet ark kopiere du blot koden til et modul i det nye regneark. Husk både at kopiere fra modulet og fra Workbooken.
Når du har kopieret koden ind i det nye regneark kan du kopier et enkelt knap-element(Eller oprette et nyt) i dit ark, og tildele dette knap-element makroen "SetTime". Herefter kopier du blot knap-elementet så mange gange som du har rækker til.
Herefter skal hvert knap-element navngives f.eks. "Billede 1", "Billede 2",. ..."Billede 25", som jeg har gjort i løsningen.
Tak for den fine forklarende tekst i excekl arket. Men må indrømme jeg ikk helt er med på det beat :)
De knapper du har navngivet billed 1 billed 2 osv. hvor ser jeg det i macroen ?
Og jeg forstår ikke hvordan navngivnigen skal følge dette princip. kan du ikke evt tage nogle screen shots hvor du viser kopiringen step by step.
Jeg prøved blot at kopier det der stod i selve excelarket direkte ind i et nyt ark men såp skriver den at den har problemer med nedenstående... håber fortsat du ville hjælpe If TimerArray(j, 1) Then
Navngivningen af dine knap-elementer , feks. "Billede 1" er vigtigt fordi makroen bruger knap-elementets navn til at bestemme, hvor værdierne skal indsættes. Ved tryk på knap-element "Billede 1" indsættes værdierne i første række, ved tryk på knap-element "Billede 2" indsættes værdierne i anden række osv. Du kan dog frit navngive knapelementerne f.eks. "Stopur 1", Stopur 2" eller noget andet - så længe navngivningen ender på en blank karakter efterfulgt af et tal. Hvis du f.eks. navngiver et knap-element "Simon 45" - så indsættes værdierne i den 45'te række under kolonneoverskriften.
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.