Avatar billede morteno Nybegynder
06. juli 2007 - 07:02 Der er 4 kommentarer og
1 løsning

Makro hjælp vedrørende dato

Hej alle

Bak lavede i sin tid en helt fantastisk makro til hjælp ved indtastning af datoer. Da jeg ikke aner noget om hvordan man ændrer sådan en makro kunne jeg godt bruge lidt hjælp.

I øjeblikket virker makroen kun for celle A1:A10, kan jeg på nogen måde få den til at virker for eksempelvis B5:B64000 samt E5:E64000. Jeg har prøvet at lege lidt med "range", men kan ikke få den til at virke.

Håber der nogen der kan hjælpe. På forhånd tak.

------------------------------

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

Dim DateStr As String

On Error GoTo EndMacro
If Application.Intersect(Target, Range("A1:A10")) Is Nothing Then
    Exit Sub
End If
If Target.Cells.Count > 1 Then
    Exit Sub
End If
If Target.Value = "" Then
    Exit Sub
End If

Application.EnableEvents = False
With Target
If .HasFormula = False Then
    Select Case Len(.Formula)
        Case 4 ' e.g., 9298 = 2-Sep-1998
            DateStr = Left(.Formula, 1) & "-" & _
            Mid(.Formula, 2, 1) & "-" & Right(.Formula, 2)
        Case 5 ' e.g., 11298 = 12-Jan-1998 NOT 2-Nov-1998
            DateStr = Left(.Formula, 1) & "-" & _
                Mid(.Formula, 2, 2) & "-" & Right(.Formula, 2)
        Case 6 ' e.g., 090298 = 2-Sep-1998
            DateStr = Left(.Formula, 2) & "-" & _
                Mid(.Formula, 3, 2) & "-" & Right(.Formula, 2)
        Case 7 ' e.g., 1231998 = 23-Jan-1998 NOT 3-Dec-1998
            DateStr = Left(.Formula, 1) & "-" & _
                Mid(.Formula, 2, 2) & "-" & Right(.Formula, 4)
        Case 8 ' e.g., 09021998 = 2-Sep-1998
            DateStr = Left(.Formula, 2) & "-" & _
                Mid(.Formula, 3, 2) & "-" & Right(.Formula, 4)
        Case Else
            Err.Raise 0
    End Select
    .Formula = DateValue(DateStr)
End If

End With
Application.EnableEvents = True
Exit Sub
EndMacro:
MsgBox "Ikke en gyldig dato."
Application.EnableEvents = True
End Sub
Avatar billede kabbak Professor
06. juli 2007 - 08:25 #1
ret
If Application.Intersect(Target, Range("A1:A10")) Is Nothing Then

til

If Application.Intersect(Target, Range("B5:B64000,E5:E64000")) Is Nothing Then
Avatar billede morteno Nybegynder
06. juli 2007 - 09:20 #2
Så simpelt og så fantastisk. Mange tak for hjælpen.

Smid endelig et svar
Avatar billede kabbak Professor
06. juli 2007 - 12:34 #3
et svar ;-))
Avatar billede morteno Nybegynder
06. juli 2007 - 13:36 #4
er pointene tildelt?
Avatar billede kabbak Professor
06. juli 2007 - 16:24 #5
ja, tak for point ;-))
Avatar billede Ny bruger Nybegynder

Din løsning...

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.

Loading billede Opret Preview
Kategori
Vi har et stort udvalg af Excel kurser. Find lige det kursus der passer dig lige her.

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester