Importer comma sepererede filer til Excel

Prøv at teste denne, jeg kunne ikke finde ud af hvor du fik Diff. fra, så du får alle data.

Public Sub HentData()
'US12345 (test1)
'JFF00001
'Testemne1
'"Nr.","value1","value2","Tryk","U(L1)","U(L2)","U(L3)","I(L1)","I(L2)","I(L3)","P1-W","P2-W","P4-W","value3","value4","Temp'","før","efter","value5","value6","Dato","Tid"
    Dim strFilNavn() As String, NO As Integer, I As Integer, RW As Long, Sdata As Variant
    Dim Linie(4) As String, Data As String, Sti
    NO = 1
    Sti = "C:\data\"    ' RET TIL DIN STI
    ReDim Preserve strFilNavn(NO)
    strFilNavn(NO) = Dir(Sti & "*.001")    ' Hent den første filnavn.
    Do While strFilNavn(NO) <> ""  ' Start løkken
        If strFilNavn(NO) <> "." And strFilNavn(NO) <> ".." Then
            NO = NO + 1
        End If
        ReDim Preserve strFilNavn(NO)
        strFilNavn(NO) = Dir    ' Hent næste filnavn.
    Loop
    NO = NO - 1

    For I = 1 To NO
        Open Sti & strFilNavn(I) For Input As #1
        Line Input #1, Linie(1)    'US12345 (test1)
        Line Input #1, Linie(2)    'JFF00001
        Line Input #1, Linie(3)  'Testemne1
        Line Input #1, Linie(4)    ' overskrifter
        If Cells(1, 2) = "" Then
            Sdata = Split(Linie(4), ",")
            Range(Cells(1, 2), Cells(1, UBound(Sdata))) = Sdata ' Overskrifter
        End If
        RW = Range("B65536").End(xlUp).Offset(1, 0).Row
        Cells(RW, 1) = Linie(2)
        Do Until EOF(1)
            Line Input #1, Data
            '    Nr.    Flow    Diff. Tryk    U(L1)

            RW = Range("B65536").End(xlUp).Offset(1, 0).Row
            Sdata = Split(Data, ",")
            Range(Cells(RW, 2), Cells(RW, UBound(Sdata))) = Sdata
        Loop
        Close 1
    Next
End Sub

Lidt rettelser.

Jeg kan ikke få dine eksempeldata til at passe med overskrifterne, Jeg har klokkeslet i datokolonnen ??.

Public Sub HentData()
    Dim strFilNavn() As String, NO As Integer, I As Integer, RW As Long, Sdata As Variant
    Dim Linie(4) As String, Data As String, Sti
    NO = 1
    Sti = "C:\data\"    ' RET TIL DIN STI
    ReDim Preserve strFilNavn(NO)
    strFilNavn(NO) = Dir(Sti & "*.001")    ' Hent den første filnavn.
    Do While strFilNavn(NO) <> ""  ' Start løkken
        If strFilNavn(NO) <> "." And strFilNavn(NO) <> ".." Then
            NO = NO + 1
        End If
        ReDim Preserve strFilNavn(NO)
        strFilNavn(NO) = Dir    ' Hent næste filnavn.
    Loop
    NO = NO - 1

    For I = 1 To NO
        Open Sti & strFilNavn(I) For Input As #1
        Line Input #1, Linie(1)    'US12345 (test1)
        Line Input #1, Linie(2)    'JFF00001
        Line Input #1, Linie(3)  'Testemne1
        Line Input #1, Linie(4)    ' overskrifter
        If Cells(1, 2) = "" Then ' tjekker om der er overskrifter i arket
            Sdata = Split(Linie(4), ",")
            Range(Cells(1, 2), Cells(1, UBound(Sdata) + 2)) = Sdata  ' Overskrifter
        End If
     
        Do Until EOF(1)
            Line Input #1, Data
            RW = Range("B65536").End(xlUp).Offset(1, 0).Row
            Sdata = Split(Data, ",")
            Cells(RW, 1) = Linie(2)
            Range(Cells(RW, 2), Cells(RW, UBound(Sdata) + 2)) = Sdata
        Loop
        Close 1
    Next
End Sub

Hej Kabbak

Det er rigtig rigtig godt ud - importen sker bare lige med det samme. Super flot.

Et spørgsmål mere.... tal er importeret med et punktum som komma adskiller.
og så er der en kommentar:
'The number in this cell is formatted as text or preceded by an apostrophe'
Jeg har fundet ud af hvordan jeg nemt kan konveterer det hele til tal.
Men kan det ikke lade sig gøre i VBA programmeringen?

Ellers ser det superflot ud - det sparer ihverfal mig for meget arbejde.

Jeg er ny på Eksperten - hvordan er det at jeg giver dig dine fortjene points?

Mvh

Jens Frederik

Nu er den lavet om, så du får komma som decimaltegn.

Jeg kunne ikke lige finde ud af hvorfor tallene var tekst, men der er en nem måde på arket.

skriv 1 i en tom celle
kopier cellen
marker alle de celler der skal være værdier
Vælg indsæt specielt > Multiplicer

Nu skal du bare formatere datoer og tid om

Public Sub HentData()
    Dim strFilNavn() As String, NO As Integer, I As Integer, RW As Long, Sdata As Variant
    Dim Linie(4) As String, Data As String, Sti As String
    NO = 1
    Sti = "C:\data\"    ' RET TIL DIN STI
    ReDim Preserve strFilNavn(NO)
    strFilNavn(NO) = Dir(Sti & "*.001")    ' Hent den første filnavn.
    Do While strFilNavn(NO) <> ""  ' Start løkken
        If strFilNavn(NO) <> "." And strFilNavn(NO) <> ".." Then
            NO = NO + 1
        End If
        ReDim Preserve strFilNavn(NO)
        strFilNavn(NO) = Dir    ' Hent næste filnavn.
    Loop
    NO = NO - 1

    For I = 1 To NO
        Open Sti & strFilNavn(I) For Input As #1
        Line Input #1, Linie(1)    'US12345 (test1)
        Line Input #1, Linie(2)    'JFF00001
        Line Input #1, Linie(3)  'Testemne1
        Line Input #1, Linie(4)    ' overskrifter
        If Cells(1, 2) = "" Then    ' tjekker om der er overskrifter i arket
            Sdata = Split(Linie(4), ",")
            Range(Cells(1, 2), Cells(1, UBound(Sdata) + 2)) = Sdata  ' Overskrifter
        End If

        Do Until EOF(1)
            Line Input #1, Data
            RW = Range("B65536").End(xlUp).Offset(1, 0).Row
            Sdata = Split(Replace(Replace(Data, ",", ";"), ".", ","), ";")
            Cells(RW, 1) = Linie(2)
            Range(Cells(RW, 2), Cells(RW, UBound(Sdata) + 2)) = Sdata
        Loop
        Close 1
    Next
   
End Sub

Med hensyn til point, skal du markere mit navn i boksen til venstre og tryk så accepter

et svar ;-))

Tusind tak for hjælpen.
Mvh
Jens Frederik