CIO Tech Eksperten IT-JOB IT-Kurser Events Podcast Søg

Log ind eller opret profil

Du kan også logge ind via nedenstående tjenester

smeeden Nybegynder

23. september 2012 - 18:16 Der er 9 kommentarer og
1 løsning

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

Synes godt om

store-morten Ekspert

23. september 2012 - 22:58 #1

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

Synes godt om

store-morten Ekspert

23. september 2012 - 23:30 #2

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

Synes godt om

smeeden Nybegynder

24. september 2012 - 07:44 #3

Hej Morten

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

Mvh
Kennet

Synes godt om

store-morten Ekspert

24. september 2012 - 23:28 #4

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?

Synes godt om

smeeden Nybegynder

25. september 2012 - 17:20 #5

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

Synes godt om

store-morten Ekspert

25. september 2012 - 19:25 #6

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

Synes godt om

smeeden Nybegynder

26. september 2012 - 19:31 #7

Hej Morten

lægger du et svar

Den sidste virker som den skal

Jeg siger tak for hjælpen

Mvh Kennet

Synes godt om

store-morten Ekspert

26. september 2012 - 19:40 #8

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

Synes godt om

store-morten Ekspert

26. september 2012 - 21:34 #9

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

Synes godt om

smeeden Nybegynder

29. september 2012 - 08:14 #10

Hej Morten

tak for hjælpen

Synes godt om

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.

Følg dette spørgsmål

Opret Preview

Flere spørgsmål fra Excel kategorien

Titel	Indlæg	Oprettet	Seneste aktivitet
Skrive tekst fra celle i formel Af SFrede i Excel	8	25/04/202414:54	26/04/202412:51
slette rækker automatisk Af torben lind i Excel	12	24/04/202418:52	26/04/202407:07
Ctrl + Backspace Af xl-Enthusiast i Excel	7	22/04/202408:15	22/04/202410:12
Lopslag Af Mariacecilia i Excel	9	19/04/202419:00	20/04/202420:01
Vagtliste med rul mellem skifter Af Klaus W i Excel	0	19/04/202413:33	-

Se alle spørgsmål i kategorien Opret spørgsmål

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

Alle kategorier på Eksperten

Seneste artiklerRSS

07:12

MitID oppe at køre igen efter flere timers nedbrud: Årsag endnu ukendt

06:00

Morgen-briefing: Kritik af Dansk Folkeparti for deling af deepfake-video af statsministeren / Oracle flytter hovedkvarter for at komme tættere på sundhedsindustrien / X vil konkurrere med Teams, Meet og Zoom

26/04

Prøvekørt: Sydkoreansk familie-kolos har plads til alle og sætter alle på plads

26/04

Køber 25.000 Copilot-licenser af Microsoft i kæmpe-aftale - vil investere milliarder i AI

26/04

En af disse 10 spændende it-stillinger kan blive det næste skridt i din karriere

26/04

Nørgaard: Gør som de andre: Tag ingen beslutninger og gør intet

26/04

Alphabet udbetaler udbytte til ejere for første gang nogensinde: Aktien stiger eksplosivt og stiftere scorer over en milliard

26/04

"Når jeg engang ikke er her mere, så vil jeg gerne huskes som generøs lige som ham"

26/04

Spotify raser: Apple blokerer vores opdatering til iPhones

26/04

Det danske it-lovsystem skal moderniseres: Styrelse søger ene-leverandør til 10-årig kæmpe-kontrakt

26/04

7N fra København runder halvanden milliard kroner i omsætning: Beskæftiger nu 1.700 konsulenter

Vis flere artikler

IT-JOB

ATP

New Tech Architect, der vil være med til at gøre ATP til et førende teknologi- og digitaliseringshus

DSV

Private Cloud Product Owner for Hybrid Computing Platform

Banedanmark

IT-projektleder til udvikling af IT-værktøjer

ATP

Enterprise Architect til rådgivning tæt på forretningen i ATP's Technology-enhed

Cognizant Technology Solutions Denmark ApS

Senior Consultant - Finance, Insurance, Pension

Vis flere jobs

Seneste spørgsmål Seneste aktivitet

I dag 06:09	Sletning af Field i all Records Af ingeman i Access
I går 19:39	Kan ikke låse afdøds mobiltelefon op Af frejanatur i Mobiltelefoner
I går 13:33	Kan ikke finde opretteren af en e-mailadresse og facebookside Af made4u.mnn i E-mail programmer
27/0419:48	Hvilken ugedag var "24. Marts, 1998" ? Af Ikke-ekspert i Fri debat
27/0414:03	“Haster” Hjælp til 240hz og konsol monitor køb. Af nalacin i Skærme