Makro og VBA - CSV importering med makro og dato formatering

CSV importering med makro og dato formatering

Udskrevet fra: Dansk Regneark Forum
Kategori: Hjælp til regneark.
Forum navn: Makro og VBA
Forum beskrivelse: Hjælp til Makroer og VBA-programmering
Web-adresse: https://forum.excel-regneark.dk/forum_posts.asp?TID=76
Udskrevet den: 19.Maj.2024 kl. 20:48

Emne: CSV importering med makro og dato formatering

Besked fra: unichaos
Emne: CSV importering med makro og dato formatering
Posteringsdato: 05.Sep.2010 kl. 20:47

Hej.

Jeg sidder og bakser med en makro i Excel 2010.

Jeg importerer en CSV-fil hvori jeg vælger tre felter, det første er et datofelt som er formateret amerikansk (med punktum) men dansk rækkefølge dd.mm.yyyy

Endvidere er der en stjerne ved nogle af datoerne som jeg fjerne med en del af makroen.

Mit problem er at Excel formatere datoerne på amerikansk, så dagen bliver til måneden og måneden bliver til dagen.

Dog indtil dagen skifter til 12+. Derefter formatere den datoen på dansk.

Hvordan får jeg Excel til at formatere det efter "dd/mm/yyyy" ?

Men feltet formateres ikke til dato før jeg har markeret datoen og trykket enter.

Hvordan løser jeg det problem?

Min makro er postet her under:

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

Sub AddCSV()

strFile = Application.GetOpenFilename(Filefilter:="CSV Files (*.CSV),*.CSV")

If strFile <> False Then

LastRow = Range("A65536").End(xlUp).Row + 1

With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & strFile, Destination:=Range("$A$" & LastRow))

.Name = "JyskeDownload"

.FieldNames = True

.RowNumbers = False

.FillAdjacentFormulas = False

.PreserveFormatting = True

.RefreshOnFileOpen = False

.RefreshStyle = xlInsertDeleteCells

.SavePassword = False

.SaveData = True

.AdjustColumnWidth = True

.RefreshPeriod = 0

.TextFilePromptOnRefresh = False

.TextFilePlatform = 1252

.TextFileStartRow = 2

.TextFileParseType = xlDelimited

.TextFileTextQualifier = xlTextQualifierDoubleQuote

.TextFileConsecutiveDelimiter = False

.TextFileTabDelimiter = False

.TextFileSemicolonDelimiter = True

.TextFileCommaDelimiter = False

.TextFileSpaceDelimiter = False

.TextFileColumnDataTypes = Array(9, 9, 1, 1, 9, 1, 9, 9)

.TextFileTrailingMinusNumbers = True

.Refresh BackgroundQuery:=False

End With

Columns("C:C").Select

Selection.NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"

Columns("A:A").Select

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

Selection.Replace What:="~*", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

Selection.Replace What:="~.", Replacement:="-", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

Selection.NumberFormat = "dd/mm/yyyy"

End If

End Sub

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

På forhånd tak.

Svar:

Besked fra: Allan
Posteringsdato: 06.Sep.2010 kl. 11:31

Hej unichaos,

Prøv med denne, jeg antager at dine datoer starter i A1 og fortsætter nedad. Hvis jeg ikke har ret, så ret A1 til den øverste celle i dit ark.

Lad os prøve om det virker :-)

//Allan

Sub AddCSV()
    strFile = Application.GetOpenFilename(Filefilter:="CSV Files (*.CSV),*.CSV")

    If strFile <> False Then
        LastRow = Range("A65536").End(xlUp).Row + 1

        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & strFile, Destination:=Range("$A$" & LastRow))
            .Name = "JyskeDownload"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 1252
            .TextFileStartRow = 2
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = True
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(9, 9, 1, 1, 9, 1, 9, 9)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With

        Columns("C:C").Select
        Selection.NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"

        Columns("A:A").Select
        Selection.Replace What:="~ ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
        Selection.Replace What:="~*", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

        Selection.TextToColumns Destination:=Range("A1"), _
        DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, _
        Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 4), _
        TrailingMinusNumbers:=True

Selection.NumberFormat = "dd\/mm\/yyyy"
End If
End Sub

Besked fra: unichaos
Posteringsdato: 06.Sep.2010 kl. 15:24

Tak, jeg kigger på det når jeg kommer hjem. Så vender jeg tilbage med resultatet. :)

Besked fra: unichaos
Posteringsdato: 06.Sep.2010 kl. 19:28

Det virker perfekt. Tusind tak for hjælpen :)

Kan man lukke tråden og markere den som besvaret?

Besked fra: Allan
Posteringsdato: 06.Sep.2010 kl. 20:22

Velbekomme, Tak for din tilbagemelding

Indlæg her i forum lukkes automatisk efter at have være inaktivt i et stykke tid, så det skal du ikke tænke på.

God aften.

//Allan