04. juli 2006 - 14:31
Der er
5 kommentarer og
1 løsning
Importer comma sepererede filer til Excel
Hej
Kan nogen hjælpe mig med at lave en automatisering af fil import til Excel?
Jeg har en mængde filer der hedder noget i retninge med jff00001.001 / jff00002.001 / osv. - ofte over 30 filer i samme biliotek.
Filen kan se sådan ud:
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"
1,10.08,25.51,402.52,400.82,400.80,4.62,4.84,4.37,2205.90,1871.13,700.66,2962,0.00,22.8,20.41,45.92,49.97,37.45,202804,2:10
2,30.03,22.47,402.33,400.43,400.61,5.55,5.84,5.29,3007.00,2609.00,1838.62,2948,0.00,22.8,20.09,42.56,49.98,70.47,202804,2:14
3,50.11,16.93,402.35,400.34,400.64,6.42,6.77,6.13,3704.10,3236.43,2311.61,2936,0.00,22.9,19.54,36.47,50.00,71.42,202804,2:18
Det jeg mest er ude efter er selve rådata = værdier på målinger - men de må gerne være markeret med filnavn, så jeg kan skille data ad.
Data må gerne stå i samme ark/sheet - ned under hinanden - så det ligner noget i denne retning.
Nr. Flow Diff. Tryk U(L1)
JBD00042 1 10,08 25,51 402,52 400,82
2 30,03 22,47 402,33 400,43
3 50,11 16,93 402,35 400,34
JBD00046 1 10,08 25,54 400,85 399,4
2 29,9 22,56 402,59 401,06
3 50,77 16,66 402,04 400,36
JBD00047 1 10,06 25,58 402,67 401,11
2 30,06 22,51 402,26 400,65
Jeg har prøvet med lidt forskellige VBA koder jeg har fundet her på eksperten eller på nettet unden at få det til at virke rigtig.
Håber der er nogen der kan hjælpe mig.
Mvh
Jens Frederik
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
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
