Oprettet søn. d. 23. september 2012 kl. 18:16:21

60 point uddelt | 10 kommentarer

smeeden (8.865 point. Point ude: 0)

Hjælp til at ændre dato

Hej

Jeg har et regne ark hvor jeg har en kolonne med noget der skulle være datoer, men det står sådan her.
12011 (skulle have været 01-20-2011)
100311 (Skulle have været 10-03-2011)

så har jeg indspillet denne makro, og den "virker" men er ikke ret hurtig, kan i hjælpe mig så den kun arbejder i hukommelsen

Sub Dato_ændring()
'
' Dato_ændring Makro
'
' Genvejstast: Ctrl+Skift+Q
'
ActiveCell.Offset(0, 2).Range("A1").Select
ActiveCell.FormulaR1C1 = "=RIGHT(RC[-2],2)"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "=LEFT(RIGHT(RC[-3],4),2)"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "=IF(LEN(RC[-4])=6,LEFT(RC[-4],2),LEFT(RC[-4],1))"
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "=DATE(2000+RC[-3],RC[-2],RC[-1])"
ActiveCell.Select
Selection.Copy
ActiveCell.Offset(0, -5).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.NumberFormat = "m/d/yyyy"
ActiveCell.Offset(0, 2).Range("A1:D1").Select
Selection.ClearContents
ActiveCell.Offset(0, -2).Range("A1").Select
ActiveCell.Offset(1, 0).Range("A1").Select
End Sub

mvh Kennet

Anmeld misbrug

Skriv et svar | Skriv en kommentar

Skrevet søn. d. 23. september 2012 kl. 22:58:03| #1

store-morten (34.247 point)

Prøv:

Sub Dato_ændring()
'
' Genvejstast: Ctrl+Skift+Q
'
År = Right(ActiveCell, 2)
Måned = Left(Right(ActiveCell, 4), 2)
If Len(ActiveCell.Formula) = 5 Then
Dag = 0 & Left(ActiveCell, 1)
End If
If Len(ActiveCell.Formula) = 6 Then
Dag = Left(ActiveCell, 2)
End If
ActiveCell.NumberFormat = "mm/dd/yyyy"
ActiveCell.Value = Dag & "-" & Måned & "-" & År
År = Empty
Måned = Empty
Dag = Empty
ActiveCell.Offset(1, 0).Range("A1").Select
End Sub

Anmeld misbrug

Skriv et svar | Skriv en kommentar

Skrevet søn. d. 23. september 2012 kl. 23:30:00| #2

store-morten (34.247 point)

Og:
Marker alle "datoer" f.eks. område A1:A10
Og ændre alle.

Sub Dato_ændring()
'
' Genvejstast: Ctrl+Skift+Q
'
For Each c In Selection.Cells

År = Right(ActiveCell, 2)
Måned = Left(Right(ActiveCell, 4), 2)
If Len(ActiveCell.Formula) = 5 Then
Dag = 0 & Left(ActiveCell, 1)
End If
If Len(ActiveCell.Formula) = 6 Then
Dag = Left(ActiveCell, 2)
End If
ActiveCell.NumberFormat = "mm/dd/yyyy"
ActiveCell.Value = Dag & "-" & Måned & "-" & År
År = Empty
Måned = Empty
Dag = Empty
ActiveCell.Offset(1, 0).Select

Next c
End Sub

Anmeld misbrug

Skriv et svar | Skriv en kommentar

Skrevet man. d. 24. september 2012 kl. 07:44:05| #3

smeeden (8.865 point)

Hej Morten

Den laver noget mystisk.
Jeg kan ikke sætte dem i nummer orden.
er det mig der laver noget forkert

Mvh
Kennet

Anmeld misbrug

Skriv et svar | Skriv en kommentar

Skrevet man. d. 24. september 2012 kl. 23:28:10| #4

store-morten (34.247 point)

Den laver disser, formateret som standard:
12011
100311

Om til, formateret som dato:
01-20-2011
10-03-2011

Der efter, ingen problem, med at sortere efter disse datoer?

Anmeld misbrug

Skriv et svar | Skriv en kommentar

Skrevet tir. d. 25. september 2012 kl. 17:20:56| #5

smeeden (8.865 point)

Hej Morten

Nu har jeg prøvet igen, og jeg kan ikke få den til det hvis der er 6 tegn, men ved 5 tegn så virker den fint

Mvh

Kennet

Anmeld misbrug

Skriv et svar | Skriv en kommentar

Skrevet tir. d. 25. september 2012 kl. 19:25:35| #6

store-morten (34.247 point)

Sub Dato_ændring()
'
' Genvejstast: Ctrl+Skift+Q
'
For Each c In Selection.Cells
c.Select
År = Right(ActiveCell, 2)
Måned = Left(Right(ActiveCell, 4), 2)
If Len(ActiveCell.Formula) = 5 Then
Dag = 0 & Left(ActiveCell, 1)
End If
If Len(ActiveCell.Formula) = 6 Then
Dag = Left(ActiveCell, 2)
End If

Svar = MsgBox(c.Address & " Indeholder " & Len(ActiveCell.Formula) & " tegn " & vbCrLf & _
vbCrLf & _
"Dag = " & Dag & vbCrLf & _
"Måned = " & Måned & vbCrLf & _
"År = " & År & vbCrLf & _
vbCrLf & _
"Er datoen " & Dag & "-" & Måned & "-" & 20 & År & " rigtig?", vbYesNo, "Godkend")

If Svar = vbYes Then

ActiveCell.NumberFormat = "mm/dd/yyyy"
ActiveCell.Value = Dag & "-" & Måned & "-" & 20 & År
År = Empty
Måned = Empty
Dag = Empty
ActiveCell.Offset(1, 0).Select

ElseIf Svar = vbNo Then
End If

Next c

End Sub

Anmeld misbrug

Skriv et svar | Skriv en kommentar

Skrevet ons. d. 26. september 2012 kl. 19:31:58| #7

smeeden (8.865 point)

Hej Morten

lægger du et svar

Den sidste virker som den skal

Jeg siger tak for hjælpen

Mvh Kennet

Anmeld misbrug

Skriv et svar | Skriv en kommentar

Skrevet ons. d. 26. september 2012 kl. 19:40:50| #8

Accepteret svar!60 point tildelt

store-morten (34.247 point)

Velbekomme.

Prøv også denne, med info om celle inhold:

Sub Dato_ændringTest()
'
' Genvejstast: Ctrl+Skift+Q
'
For Each c In Selection.Cells
c.Select
År = Right(ActiveCell, 2)
If År <> "" Then
År = 20 & År
End If
Måned = Left(Right(ActiveCell, 4), 2)
If Len(ActiveCell.Formula) = 5 Then
Dag = 0 & Left(ActiveCell, 1)
End If
If Len(ActiveCell.Formula) = 6 Then
Dag = Left(ActiveCell, 2)
End If

If Måned > 12 Then Bemærk1 = " <-- !!!"
If Dag > 31 Then Bemærk2 = " <-- !!!"

If IsEmpty(ActiveCell) Then
test1 = "Ja."
Else: test1 = "Nej."
End If
If IsNumeric(ActiveCell.Value) Then
test2 = "Ja."
Else: test2 = "Nej."
End If
If IsError(ActiveCell.Value) Then
test3 = "Ja."
Else: test3 = "Nej."
End If
If IsDate(ActiveCell.Value) Then
test4 = "Ja."
Else: test4 = "Nej."
End If
If ActiveCell.FormatConditions.Count > 0 Then
test5 = "Ja."
Else: test5 = "Nej."
End If
If Len(ActiveCell.Formula) > 0 Then
test6 = Len(ActiveCell.Formula)
Else: test6 = "0"
End If

Svar = MsgBox("Celle " & c.Address & " indeholder:" & vbCrLf & _
vbCrLf & _
"Tom: " & vbTab & vbTab & vbTab & test1 & vbCrLf & _
"Tal: " & vbTab & vbTab & vbTab & test2 & vbCrLf & _
"Fejl: " & vbTab & vbTab & vbTab & test3 & vbCrLf & _
"Dato: " & vbTab & vbTab & vbTab & test4 & vbCrLf & _
"Betinget formatering: " & vbTab & test5 & vbCrLf & _
"Antal tegn: " & vbTab & vbTab & test6 & vbCrLf & _
vbCrLf & _
"Dag = " & vbTab & Dag & Bemærk2 & vbCrLf & _
"Måned = " & Måned & Bemærk1 & vbCrLf & _
"År = " & vbTab & År & vbCrLf & _
vbCrLf & _
"Vil du bruge: " & vbTab & Dag & "-" & Måned & "-" & År & vbCrLf & _
"Som dato i cellen?", vbYesNo, "Godkend")

If Svar = vbYes Then

ActiveCell.NumberFormat = "mm/dd/yyyy"
ActiveCell.Value = Dag & "-" & Måned & "-" & År
År = Empty
Måned = Empty
Dag = Empty
ActiveCell.Offset(1, 0).Select

ElseIf Svar = vbNo Then
End If

Next c

End Sub

Anmeld misbrug

Skriv et svar | Skriv en kommentar

Skrevet ons. d. 26. september 2012 kl. 21:34:32| #9

store-morten (34.247 point)

Og lige en sidste, der kun gir boks, ved problemer:

Sub Dato_ændring_Advarsel()
'
' Genvejstast: Ctrl+Skift+Q
'
For Each c In Selection.Cells
c.Select
År = Right(ActiveCell, 2)
If År <> "" Then
År = 20 & År
End If
Måned = Left(Right(ActiveCell, 4), 2)
If Len(ActiveCell.Formula) = 5 Then
Dag = 0 & Left(ActiveCell, 1)
End If
If Len(ActiveCell.Formula) = 6 Then
Dag = Left(ActiveCell, 2)
End If

If Måned > 12 Then GoTo Advarsel

If Dag > 31 Then GoTo Advarsel

If IsEmpty(ActiveCell) Then GoTo Advarsel

If Not IsNumeric(ActiveCell.Value) Then GoTo Advarsel

If IsError(ActiveCell.Value) Then GoTo Advarsel

If IsDate(ActiveCell.Value) Then GoTo Advarsel

If Len(ActiveCell.Formula) < 5 Then GoTo Advarsel

If Len(ActiveCell.Formula) > 6 Then GoTo Advarsel

GoTo Ændre

Advarsel:
Svar = MsgBox("Dag = " & vbTab & Dag & Bemærk2 & vbCrLf & _
"Måned = " & Måned & Bemærk1 & vbCrLf & _
"År = " & vbTab & År & vbCrLf & _
vbCrLf & _
"Vil du bruge: " & vbTab & Dag & "-" & Måned & "-" & År & vbCrLf & _
"Som dato i cellen?", vbYesNo, "Godkend")

If Svar = vbYes Then
Ændre:
ActiveCell.NumberFormat = "mm/dd/yyyy"
ActiveCell.Value = Dag & "-" & Måned & "-" & År
År = Empty
Måned = Empty
Dag = Empty
ActiveCell.Offset(1, 0).Select

ElseIf Svar = vbNo Then
End If

Next c

End Sub

Anmeld misbrug

Skriv et svar | Skriv en kommentar