02. marts 2006 - 22:02Der er
31 kommentarer og 1 løsning
Hendt txtfil ind i excel med macro
Hej eksperter Er der en der kan hjælpe mig med at hente en txt fil ind i excel. det skal være med en macro, og text.txt filen ligger i samme mappe som excel filen. jeg har prøvet men denne kode, den hendter hele linjeren ind i første celle
Public Sub TxtFilTest6() Dim FilNummer As Integer Dim FilNavn As String Dim Linje As String
'Unikt filnummer findes FilNummer = FreeFile FilNavn = "F:\mvh\Excel\VBA Excel\mvh.txt"
Open FilNavn For Input As #FilNummer Do 'Henter en linje ad gangen Line Input #FilNummer, Linje Range("A1").Value = Linje Line Input #FilNummer, Linje Range("A2").Value = Linje Line Input #FilNummer, Linje Range("A3").Value = Linje Line Input #FilNummer, Linje Range("A4").Value = Linje Line Input #FilNummer, Linje Range("A5").Value = Linje
Loop Until EOF(FilNummer) Close #FilNummer End Sub
for vær mellem rum der er i textfilen vandret skal den skift celle når der ikke er mere text vandret skal den skifte linje kan man lave hvad for en celle den skal begynde i eksempel i b3-c3-d3-e3 b4-c4-d4-e4 b5-c5-d5-e5 også vider
Public Sub TxtFilTest6() Dim FilNummer As Integer Dim FilNavn As String Dim Linje As String Dim X Dim I As Integer Dim R As Long 'Unikt filnummer findes FilNummer = FreeFile FilNavn = "F:\mvh\Excel\VBA Excel\mvh.txt" R = 1 Open FilNavn For Input As #FilNummer Do 'Henter en linje ad gangen Line Input #FilNummer, Linje X = Split(linie, " ") For I = 0 To UBound(linie) Range("A" & R).Offset(0, I) = X(I) Next R = R + 1 Loop Until EOF(FilNummer) Close #FilNummer End Sub
Public Sub TxtFilTest6() Dim FilNummer As Integer Dim FilNavn As String Dim Linje As String Dim S As Variant Dim x As Long
'Unikt filnummer findes FilNummer = FreeFile FilNavn = "c:\mappe1.txt"
Open FilNavn For Input As #FilNummer Do 'Henter en linje ad gangen x = x + 1 Line Input #FilNummer, Linje S = Split(Application.WorksheetFunction.Trim(Linje), " ") Range("A" & x).Resize(, UBound(S)) = S Loop Until EOF(FilNummer) Close #FilNummer End Sub
dohh, havde ikke lige opdateret og set kabbaks kode. De er jo stort set ens :-) mvhansen -> du kalder en forkert makro (navnet er ikke rigtigt) , derfor fejlen
Kan man ikke lave dette om F:\mvh\Excel\VBA Excel\mvh.txt så man kan flytte excel filen og textfile uden at skal lave vejen til textfilen om de vil altid ligge i samme mappe
Selvom kabbaks kode er først og ok, vil jeg da lige benytte muligheden for at komme med en rettelse til min egen. Range("A" & x).Resize(, UBound(S)) = S ændres til Range("A" & x).Resize(, UBound(S) + 1) = S
Kabbak din melder fejl Run-time error '13' type mismatch
ved For I = 0 To UBound(linie)
Public Sub Hent_proe_txt() Dim FilNummer As Integer Dim FilNavn As String Dim Linje As String Dim X Dim I As Integer Dim R As Long 'Unikt filnummer findes FilNummer = FreeFile FilNavn = ThisWorkbook.Path & "\mvh.txt" R = 1 Open FilNavn For Input As #FilNummer Do 'Henter en linje ad gangen Line Input #FilNummer, Linje X = Split(linie, " ") For I = 0 To UBound(linie) Range("A" & R).Offset(0, I) = X(I) Next R = R + 1 Loop Until EOF(FilNummer) Close #FilNummer
Det ville være rat hvis man kan stille hvadfor en cele man vil starte i fordi jeg har en overskrift din kabbak hvis den ikke melder fejl kan den stilles på
Public Sub Hent_proe_txt() Dim FilNummer As Integer Dim FilNavn As String Dim Linje As String Dim X Dim I As Integer Dim R As Long 'Unikt filnummer findes FilNummer = FreeFile FilNavn = ThisWorkbook.Path & "\mvh.txt" R = 1 Open FilNavn For Input As #FilNummer Do 'Henter en linje ad gangen Line Input #FilNummer, Linje X = Split(Linje, " ") For I = 0 To UBound(Linje) Range("A" & R).Offset(0, I) = X(I) Next R = R + 1 Loop Until EOF(FilNummer) Close #FilNummer
Public Sub Hent_proe_txt() Dim FilNummer As Integer Dim FilNavn As String Dim Linje As String Dim X Dim I As Integer Dim R As Long 'Unikt filnummer findes FilNummer = FreeFile FilNavn = ThisWorkbook.Path & "\mvh.txt" R = 1' ret til det linie nummer, der skal startes på Open FilNavn For Input As #FilNummer Do 'Henter en linje ad gangen Line Input #FilNummer, Linje X = Split(Linje, " ") For I = 0 To UBound(Linje) Range("A" & R).Offset(0, I) = X(I)' ret A til den kolonne der skal startes i Next R = R + 1 Loop Until EOF(FilNummer) Close #FilNummer
jeg har nu lavet så at den tjekker om der er mellemrum først
Public Sub Hent_proe_txt() Dim FilNummer As Integer Dim FilNavn As String Dim Linje As String Dim X As Variant Dim I As Integer Dim R As Long 'Unikt filnummer findes FilNummer = FreeFile FilNavn = ThisWorkbook.Path & "\mvh.txt" R = 1 ' ret til det linie nummer, der skal startes på Open FilNavn For Input As #FilNummer Do 'Henter en linje ad gangen Line Input #FilNummer, Linje If InStr(1, Trim(Linje), " ") > 0 Then X = Split(Trim(Linje), " ") For I = 0 To UBound(X) Range("A" & R).Offset(0, I) = X(I) ' ret A til den kolonne der skal startes i Next Else Range("A" & R) = Linje End If R = R + 1 Loop Until EOF(FilNummer) Close #FilNummer End Sub
Kabbak->den laver vel ikke fejl, fordi der ikke er et mellemrum. Det vil bare sætte ubound(x) til 0. Det må være fordi han rammer en tom linie at den fejler eller.....
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.