Formater indtastning i excel 2003 med VBA

Sæt denne i arkets modul

Husk at du altid skal skrive året med 2 tal og ikke 4

Private Sub Worksheet_Change(ByVal Target As Range)
If IsDate(Left(Target, 2) & "-" & Mid(Target, 3, 2) & "-" & Mid(Target, 5, 5) & ":" & Right(Target, 2)) Then
Target = Left(Target, 2) & "-" & Mid(Target, 3, 2) & "-" & Mid(Target, 5, 5) & ":" & Right(Target, 2)
End If
End Sub

Hej kabbak.

Det virker bare PERFEKT. Hvor svært kan det egentlig være. Én ting jeg ikke forstår er hvorfor bruger man "Target" og ikke en specifik celle ?.

Mvh.

Christian_h

PS. du kan jo give at svar så får du point.

prøv lige at skrive 100506 1230

Hmmm, jaaaa, så bliver der byttet rundt på dag og måned ?!?, hvorfor mon det ?

Det er vba's måde at gøre tingene på der driller. Denne her forhindrer dette.
Target refererer til den celle der lige er blevet ændret.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim vTemp
Dim dato As Long
Dim tid As Double

  If Not Intersect(Target, Range("A:A")) Is Nothing Then
      Application.EnableEvents = False
      If Not IsDate(Target) And Len(Target) = 11 Then
        vTemp = Split(Target, " ")
        dato = DateSerial(Mid(vTemp(0), 5, 2), Mid(vTemp(0), 3, 2), Mid(vTemp(0), 1, 2))
        tid = TimeSerial(Mid(vTemp(1), 1, 2), Mid(vTemp(1), 3, 2), 0)
        Target = dato + tid
        Target.NumberFormat = "dd/mm/yy hh:mm;@"
      End If
  End If
  Application.EnableEvents = True
End Sub

Virker kun på kolonne A men kan udvides

OKay, gider du forklare din kode, så er det jo nok den der vinder !.

Christian_h

OK, den skal kunne virke op til og med kolonne H vil jeg tro, er det svært ?

If Not Intersect(Target, Range("A:A")) Is Nothing Then
ændres til
If Not Intersect(Target, Range("A:H")) Is Nothing Then

OK, er der nogen grund til at man ikke med det samme laver den til kolonne AA bare for at være på den sikre side ?, bruger det hukommelse eller noget andet ?

Nej, det er bare for at man normalt ikke vil bruge hele sit ark til at skrive datoer i. De fleste vil jo også gerne bruge celler til tekst, formler mv.

Her er den med lidt forklaring

Private Sub Worksheet_Change(ByVal Target As Range)
Dim vTemp
Dim dato As Long
Dim tid As Double
' check om cellen der er ændret ligger i kolonnerne A til H
  If Not Intersect(Target, Range("A:H")) Is Nothing Then
      'kør ikke andre makroer imens
      Application.EnableEvents = False
      'Hvis det ikke allerede er en dato og hvis længden er præcis 11 karakterer
      If Not IsDate(Target) And Len(Target) = 11 Then
        'del i to strenge ved mellemrummet
        vTemp = Split(Target, " ")
        'lav 1. streng til rigtig dato
        dato = DateSerial(Mid(vTemp(0), 5, 2), Mid(vTemp(0), 3, 2), Mid(vTemp(0), 1, 2))
        'lav 2. streng til rigtig tid
        tid = TimeSerial(Mid(vTemp(1), 1, 2), Mid(vTemp(1), 3, 2), 0)
        'læg disse sammen og skriv resultatet tilbage til cellen
        Target = dato + tid
        'indsæt et dato/tisformat på cellen
        Target.NumberFormat = "dd/mm/yy hh:mm;@"
      End If
  End If
  'kør igen andre makroer/events
  Application.EnableEvents = True
End Sub

Der mangler faktisk en lille krølle, der chekker om der kun er tal i cellen

Private Sub Worksheet_Change(ByVal Target As Range)
Dim vTemp
Dim dato As Long
Dim tid As Double
  ' check om cellen der er ændret ligger i kolonnerne A til H
  If Not Intersect(Target, Range("A:H")) Is Nothing Then
      'kør ikke andre makroer imens
      Application.EnableEvents = False
      'Hvis det ikke allerede er en dato og hvis længden er præcis 11 karakterer
      If Not IsDate(Target) And Len(Target) = 11 Then
        'er der kun tal ?
        If IsNumeric(Application.Substitute(Target, " ", "")) Then
            'del i to strenge ved mellemrummet
            vTemp = Split(Target, " ")
            'lav 1. streng til rigtig dato
            dato = DateSerial(Mid(vTemp(0), 5, 2), Mid(vTemp(0), 3, 2), Mid(vTemp(0), 1, 2))
            'lav 2. streng til rigtig tid
            tid = TimeSerial(Mid(vTemp(1), 1, 2), Mid(vTemp(1), 3, 2), 0)
            'læg disse sammen og skriv resultatet tilbage til cellen
            Target = dato + tid
            'indsæt et dato/tisformat på cellen
            Target.NumberFormat = "dd/mm/yy hh:mm;@"
        End If
      End If
  End If
  'kør igen andre makroer/events
  Application.EnableEvents = True
End Sub

OK, vil det sige at man ikke kan bruge andre celle i disse kolonner til andet end datoer efter indførsel af denne kode ?, for i så fald duer det ikke, man skal uden videre kunne bruge alle andre celle til beregninger, ellers skal koden laves sådan, at man angiver hvilke celler man skal kunne gøre dette i.

Mvh.
Christian_h

Denne linie styrer det
If Not Intersect(Target, Range("A:H")) Is Nothing Then

Du kan fint skrive
If Not Intersect(Target, Range("A12:B16, C15:H40")) Is Nothing Then

Private Sub Worksheet_Change(ByVal Target As Range)
If IsDate(Left(Target, 2) & "-" & Mid(Target, 3, 2) & "-" & Mid(Target, 5, 5) & ":" & Right(Target, 2)) Then
  Application.EnableEvents = False
Target = DateSerial(Mid(Target, 5, 2), Mid(Target, 3, 2), Left(Target, 2)) + TimeSerial(Mid(Target, 8, 2), Right(Target, 2), 0)
  Application.EnableEvents = True
End If
Application.EnableEvents = True
End Sub

bak: Hvad vil der ske med den anden data som står i kolonner som man tjekker på med koden ?, såvidt jeg kan se, sker der ikke noget med den ?.

kabbak: med din nye kode, bliver årstal skrevet som 2006, det skal kun skrives med 2 decimaler feks 06

Private Sub Worksheet_Change(ByVal Target As Range)
If IsDate(Left(Target, 2) & "-" & Mid(Target, 3, 2) & "-" & Mid(Target, 5, 5) & ":" & Right(Target, 2)) Then
  Application.EnableEvents = False
Target = DateSerial(Mid(Target, 5, 2), Mid(Target, 3, 2), Left(Target, 2)) + TimeSerial(Mid(Target, 8, 2), Right(Target, 2), 0)
  Target.NumberFormat = "dd/mm/yy hh:mm;@"

End If
Application.EnableEvents = True
End Sub

OK gutter, hvilken en er så bedst ? og mest stabil, skal bruges i en "KÆMPE" regne ark. med mange sider osv.

Hvis du skal bruge koden i mange ark (Faner), så vil det nok være en fordel at sætte koden ind i ThisWorkbook modulet, i stedet for arkmodulet, så virker den på alle ark.

så ser den sådan ud.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  If IsDate(Left(Target, 2) & "-" & Mid(Target, 3, 2) & "-" & Mid(Target, 5, 5) & ":" & Right(Target, 2)) Then
        Application.EnableEvents = False
        Target = DateSerial(Mid(Target, 5, 2), Mid(Target, 3, 2), Left(Target, 2)) + TimeSerial(Mid(Target, 8, 2), Right(Target, 2), 0)
        Target.NumberFormat = "dd/mm/yy hh:mm;@"
    End If
    Application.EnableEvents = True
End Sub

lukket, da svar desværre ikke kunne bruges :-(