Beregning af afspadsering

PS.
Løsningen skulle gerne være sådan at jeg kan indtaste f.eks. 12000 og det så bliver lavet om til 120:00

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    On Error GoTo Slut
    If Not Intersect(Target, Range("C5:AO66")) Is Nothing Then
        If IsNumeric(Target) Then
        Application.EnableEvents = False
        If Val(Right(Target, 2)) > 59 Then
        Target = "Fejl"
        Exit Sub
        End If
            Target = Left(Target, Len(Target) - 2) & ":" & Right(Target, 2)
            Application.EnableEvents = True
        End If
    End If
Slut:
End Sub

Tak kabbak
Den tager sig jo af hele området
Læg et svar så du kan få point (som sædvanlig) ;-)

et svar ;-))

>Kabbak
Det var alligevel ikke helt godt.
Hvis en indtastning er mindre end 1 time, f.eks 45 minutter taster jeg bare 45. Så viser cellen [:45] og jeg får jeg en fejlværdi (4 hash-tegn) i en sammentælling.
Dette sker også selv om jeg sætter nuller foran.

Hvis jeg sletter en indtastning fordi den er forkert (F.eks. 2 timer slettes, 3 timer indtastes) får jeg fejlværdi (4 hash-tegn)i indtastningscellen.

Derefter vil alle indtastninger give fejlværdi.

Fejlen kommer også hvis jeg bare taster oven i

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim Tim As Variant
    On Error GoTo Slut
    If Not Intersect(Target, Range("C5:AO66")) Is Nothing Then
        If IsNumeric(Target) Then
        Application.EnableEvents = False
       
        If Val(Right(Target, 2)) > 59 Then
        Target = "Fejl"
        Exit Sub
        End If
        If Val(Left(Target, Len(Target) - 2)) = 0 Then
        Tim = "00"
        Else
        Tim = Left(Target, Len(Target) - 2)
        End If
            Target = Tim & ":" & Right(Target, 2)
            Application.EnableEvents = True
        End If
    End If
Slut:
End Sub

Det tog sig af fejlen med 'mindre end 1 time' men der kommer stadig fejl hvis jeg ændrer en indtastning.
Og derefter vil alle indtastninger give fejl.
Måske skulle jeg sende dig arket?

har ikke tid før i aften

kabbak snabela tiscali dot dk

Fint nok.
Sender AfspadseringsListe2.xls

prøv at teste denne

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim Tim As Variant

    If Not Intersect(Target, Range("C5:AO66")) Is Nothing Then
        If Target.Cells.Count > 1 Or Len(Target) = 0 Then GoTo Slut
        If IsNumeric(Target) Then
            Application.EnableEvents = False
            If Val(Right(Target, 2)) > 59 Then
                Target = "Fejl"
                Exit Sub
            End If
            If Val(Left(Target, Len(Target) - 2)) = 0 Then
                Tim = "00"
            Else
                Tim = Left(Target, Len(Target) - 2)
            End If
            Target = Tim & ":" & Right(Target, 2)
            Target.NumberFormat = "[h]:mm"
            Application.EnableEvents = True
        End If
    End If
    Exit Sub
Slut:
If IsEmpty(Target) Then Target.NumberFormat = "General"
End Sub


hvis den ikke skulle trikke denne linie
Application.EnableEvents = True
så slår den koden fra

derfor har jeg altid en makro der kan slå den til igen

Public Sub SartAutomatiskeFunktioner()
Application.EnableEvents = True
End Sub


brug den hvis du ikke synes at makroen kører

Tilføjede en linje du har slettet.
Nu ser den sådan ud, og det ser ud til at den virker.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim Tim As Variant
On Error GoTo Slut
    If Not Intersect(Target, Range("C5:AO100")) Is Nothing Then
        If Target.Cells.Count > 1 Or Len(Target) = 0 Then GoTo Slut
        If IsNumeric(Target) Then
            Application.EnableEvents = False
            If Val(Right(Target, 2)) > 59 Then
                Target = "Fejl"
                Exit Sub
            End If
            If Val(Left(Target, Len(Target) - 2)) = 0 Then
                Tim = "00"
            Else
                Tim = Left(Target, Len(Target) - 2)
            End If
            Target = Tim & ":" & Right(Target, 2)
            Target.NumberFormat = "[h]:mm"
            Application.EnableEvents = True
        End If
    End If
    Exit Sub
If IsEmpty(Target) Then Target.NumberFormat = "General"
Slut:
End Sub

Prøver den lige igennem, men bli'r nok først færdig engang i løbet af aftenen.

det er ikke meningen at linien
On Error GoTo Slut
skal være der, den fanger fejl i denne linie

If Target.Cells.Count > 1 Or Len(Target) = 0 Then GoTo Slut

Har fjernet On Error GoTo Slut.
Der optræder stadig fejlmeldinger.

Jeg får følgende fejlmelding:
Run-time error '1004':
Kan ikke angive egenskaben NumberFormat for klassen Range.
Og debuggeren peger på denne linje
->      Target.NumberFormat = "[h]:mm"

Jeg har så gjort linjen til en bemærkning med '.

Når jeg derefter indtaster et timetal i startkolonnen (kolonne C) får jeg en fejlværdi (4 hash-tegn), både i cellen i kolonne C og i sammentællingscellen under hver måned.
Det er lige meget hvordan jeg indtaster værdien (12000 eller 1200 eller 0 eller 0:00)
Jeg starter så 'Application.EnableEvents = True'-makroen, og indtaster tallet igen. Det går da, men er jo lidt bøvlet.

Hvis jeg indtaster et 0 i startkolonnen (kolonne C) får jeg følgende fejlmelding:
Run-time error '5'
Invalid procedure call or argument
Og debuggeren peger på denne linje
->      If Val(Left(Target, Len(Target) - 2)) = 0 Then

Ja, så er der lige det, at det ikke er hver gang det sker. Det er som om at koden virker et stykke tid når den først er kommet i gang!

?????

Du skal minst have 2 tegn, så ved 0 minut, tastes 00.

#### betyder at kolonnen ikke er bred nok.

I koden er der lavet sådan, at hvis det tal den viser, er helt forkert, så slet indholdet, skift en anden celle, gå tilbage og tast ind igen.

prøv at se om det at du bruger 00 i kolonne c, ikke gør at fejlen løser sig

Den med 00 er rigtig nok, men burde linjen 'If Target.Cells.Count > 1 Or Len(Target) = 0 Then GoTo Slut' ikke fange den?
Det med #### burde jeg selv have tænkt på, ved udvidelse af kolonnen viser det sig at koden laver en indtastning på 12000 om til 288000:00 og det er kolonnen ikke bred nok til.
Men skulle koden ikke lave 12000 om til 120:00 ?
Når jeg så kører
Public Sub StartAutomatiskeFunktioner()
Application.EnableEvents = True
End Sub
Så virker det igen ?
Jeg kan så anvende arket et stykke tid uden fel, men de kommer igen på et eller andet tidspunkt.