Avatar billede michaelrar Seniormester
26. september 2017 - 08:24 Der er 13 kommentarer og
4 løsninger

VBA ændre format på datofelt

Hej Hajer!

Har en pudsighed jeg ikke kan finde en work around løsning på :-(
Har et Excelark hvor jeg har 2 kolonner med datofelter ( kopieret fra MS Project) i dette format: "On 01-11-17".
Her prøver jeg at få fjernet den foranstillede ugedag med "søg og erstat". Gør jeg det manuelt, virker det fint, men indspiller jeg en makro og kører den, så ender resultatet således:
01-11-17

Kode:
Selection.Replace What:="on ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

Nogen gode ideer ?

Kører Office 365 Dansk
Avatar billede Jan Hansen Ekspert
26. september 2017 - 09:04 #1
1. hvilket format ønsker du retur ?
2. Hvilket område drejer det sig om?
3. Har du prøvet at lave et nyt ark hvor du i cellerne skriver eks i A1  "=ark!A1" og formaterer kolonnen til det dato format du ønsker?

evt kan du Uploade et ark til dropbox indeholdende de to kolonner (slet bare data i øvrige kolonner)

Jan
Avatar billede michaelrar Seniormester
26. september 2017 - 21:31 #2
Vender lige tilbage, men ikke sikkert det bliver før torsdag, er lige lidt ophængt😬😝
Avatar billede finb Ekspert
27. september 2017 - 12:20 #3
Jamen er dit eget svar "01-11-17" ikke korrekt ?
Avatar billede michaelrar Seniormester
27. september 2017 - 13:40 #4
Jo
Avatar billede excelent Ekspert
27. september 2017 - 22:42 #5
Marker dine datoer og kør makro ( på en kopi !!! )

Sub retFormat()
For Each c In Selection
c.NumberFormat = "dd-mm-yyyy"
Next
End Sub
Avatar billede michaelrar Seniormester
02. oktober 2017 - 09:58 #6
Her er et eksempel, hvor fejlen opstår hvis man kører makroen, men ikke hvis man kører søg og erstat i "hånden"

https://www.dropbox.com/s/tsukquii1g3m61t/S%C3%B8g%20og%20erstat%20fejler%20i%20datokonvertering.xlsm?dl=0

Formatet skal gerne ende med dd-mm-yyyy eller alternativt dd-mm-yy
Avatar billede Jan Hansen Ekspert
02. oktober 2017 - 17:25 #7
Hejsa

Prøv denne macro:



Dim ws As Worksheet
Dim rColumns As Range, rCell As Range, MyDate As Date
Dim MyArray() As Variant

Public Sub Soegogerstat()

Set ws = ActiveSheet
Set rColumns = ws.Range("D2")
Set rColumns = Range(rColumns, rColumns.End(xlDown).Offset(0, 1))
    With rColumns
        MyArray = .Value
        For iCount = 1 To UBound(MyArray, 1)
            If Len(MyArray(iCount, 1)) > 8 Then
                MyDate = Mid(MyArray(iCount, 1), 4, 8)
                MyArray(iCount, 1) = MyDate
            End If
            If Len(MyArray(iCount, 2)) > 8 Then
                MyDate = Mid(MyArray(iCount, 2), 4, 8)
                MyArray(iCount, 2) = MyDate
            End If

        Next
        .Value = MyArray
        .NumberFormat = "dd-mm-yy"
    End With
End Sub

Avatar billede Jan Hansen Ekspert
02. oktober 2017 - 17:27 #8
.NumberFormat = "dd-mm-yy"

kan også rettes til

.NumberFormat = "dd-mm-yyyy"

alt efter om du vil have 17 eller 2017
Avatar billede excelent Ekspert
02. oktober 2017 - 19:24 #9
Avatar billede michaelrar Seniormester
02. oktober 2017 - 19:47 #10
Hej Jan

Det var din makro der tog stikket hjem.
Jeg har opdaget jeg skrev noget sludder i opgaveformuleringen, det er rent faktisk skete var, at når jeg kørte min makro, så konverterede den en dato som f.eks.
"on 01-11-17" til 11-01-17", mens hvis jeg gjorde det manuelt med søg og erstat så virkede det fint.
Nogen der har et bud/forklaring på årsagen ?

Tusind tak for hjælpen til alle
Avatar billede michaelrar Seniormester
03. oktober 2017 - 09:37 #11
Nå, var lige skråsikker nok.

Det går desværre også galt med den kode :-(

https://www.dropbox.com/s/tsukquii1g3m61t/S%C3%B8g%20og%20erstat%20fejler%20i%20datokonvertering.xlsm?dl=0
Avatar billede Jan Hansen Ekspert
03. oktober 2017 - 11:10 #12
Prøv denne:



Dim ws As Worksheet
Dim rColumns As Range, rCell As Range, MyDate As Date
Dim MyArray() As Variant

Public Sub Datoer()
    Set ws = ActiveSheet
    ' kolonner du vil have renset
    SøgOgErstat ws.Range("D2:E2")
    SøgOgErstat ws.Range("G2:H2")
End Sub


Sub SøgOgErstat(Var As Range)


Set rColumns = Var
Set rColumns = Range(rColumns, rColumns.End(xlDown).Offset(0, 1))
    With rColumns
        MyArray = .Value
        For icount = 1 To UBound(MyArray, 1)
            If Len(MyArray(icount, 1)) > 8 Then
                MyDate = Mid(MyArray(icount, 1), 4, 8)
                MyArray(icount, 1) = MyDate
            Else
                MyDate = MyArray(icount, 1)
                MyArray(icount, 1) = MyDate
            End If
            If Len(MyArray(icount, 2)) > 8 Then
                MyDate = Mid(MyArray(icount, 2), 4, 8)
                MyArray(icount, 2) = MyDate
            Else
                MyDate = MyArray(icount, 2)
                MyArray(icount, 2) = MyDate
            End If

        Next
        .Value = MyArray
        .NumberFormat = "dd-mm-yy"
    End With
End Sub

Avatar billede michaelrar Seniormester
03. oktober 2017 - 13:09 #13
Så er den der.

En lille ting tilbage der driller nu er, at første gang den møder en tom række, så stopper koden. Det kan jeg ikke lige gennemskue, hvordan det er bedst at rette.
Tak for al hjælpen ind til videre, det har været meget værdifuldt for mig :-)
Avatar billede Jan Hansen Ekspert
03. oktober 2017 - 13:53 #14
Prøv denne



Dim ws As Worksheet
Dim rColumns As Range, rCell As Range
Dim MyDate As Date
Dim rPluds As Range
Dim MyArray() As Variant

Public Sub Datoer()
    Set ws = ActiveSheet
    ' kolonner du vil have renset
    SøgOgErstat ws.Range("D2:E2")
    SøgOgErstat ws.Range("G2:H2")
End Sub


Sub SøgOgErstat(Var As Range)


Set rColumns = Var
Set rPluds = rColumns.End(xlDown)
If Not rPluds.Offset(2, 0).Value = "" Then Set rPluds = rPluds.Offset(2, 0)

Set rColumns = Range(rColumns, rPluds.Offset(0, 1))
    With rColumns
        MyArray = .Value
        For icount = 1 To UBound(MyArray, 1)
            If Not MyArray(icount, 1) = "" Then
                If Len(MyArray(icount, 1)) > 8 Then
                    MyDate = Mid(MyArray(icount, 1), 4, 8)
                    MyArray(icount, 1) = MyDate
                Else
                    MyDate = MyArray(icount, 1)
                    MyArray(icount, 1) = MyDate
                End If
                MyDate = xlNone
            End If
            If Not MyArray(icount, 2) = "" Then
                If Len(MyArray(icount, 2)) > 8 Then
                    MyDate = Mid(MyArray(icount, 2), 4, 8)
                    MyArray(icount, 2) = MyDate
                Else
                    MyDate = MyArray(icount, 2)
                    MyArray(icount, 2) = MyDate
                End If
                MyDate = xlNone
            End If
        Next
        .Value = MyArray
        .NumberFormat = "dd-mm-yy"
    End With
End Sub

Avatar billede Jan Hansen Ekspert
03. oktober 2017 - 13:57 #15
If Not rPluds.Offset(2, 0).Value = "" Then Set rPluds = rPluds.Offset(2, 0)

denne bestemmer hvor mange tomme rækker, her tester den en række under første tomme række
Avatar billede Jan Hansen Ekspert
03. oktober 2017 - 16:00 #16
Nå så virker det som det skal?

Jan
Avatar billede michaelrar Seniormester
05. oktober 2017 - 13:18 #17
Jeps! - det er lige som ønsket :-)
Tusind mange tak for hjælpen.
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

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