Indlæse fil (US-ASCII) vha.makro

Jeg regner med at det er en .CSV fil, ellers ret der hvor der står CSV

Den kommer med en stifinder, så kan du vælge filen

Den skriver i det aktive ark.


Public Sub HentCSVData()

    Dim strline() As Variant, X As Long, Str As String, fileToOpen As Variant, RES() As Variant, I As Long
    'Således at man ikke indlæser de første 4 linjer og kun kolonnerne 1,2,7,8,9,10,11 og man starter i Celle A2.
    fileToOpen = Application.GetOpenFilename("CSVfiler (*.csv), *.csv")
    If fileToOpen <> False Then
        Open fileToOpen For Input As #1
        Line Input #1, Str
        Line Input #1, Str
        Line Input #1, Str
        Line Input #1, Str
        X = 0
        Do
            Line Input #1, Str
            ReDim Preserve strline(X)
            strline(X) = Split(Str, ";")(0)
            strline(X) = strline(X) & ";" & Split(Str, ";")(1)
            strline(X) = strline(X) & ";" & Split(Str, ";")(6)
            strline(X) = strline(X) & ";" & Split(Str, ";")(7)
            strline(X) = strline(X) & ";" & Split(Str, ";")(8)
            strline(X) = strline(X) & ";" & Split(Str, ";")(9)
            strline(X) = strline(X) & ";" & Split(Str, ";")(10)
            X = X + 1
        Loop Until EOF(1)
        Close #1
        ReDim RES(X - 1, 6)
        For I = 0 To X - 1
            RES(I, 0) = Split(strline(I), ";")(0)
            RES(I, 1) = Split(strline(I), ";")(1)
            RES(I, 2) = Split(strline(I), ";")(2)
            RES(I, 3) = Split(strline(I), ";")(3)
            RES(I, 4) = Split(strline(I), ";")(4)
            RES(I, 5) = Split(strline(I), ";")(5)
            RES(I, 6) = Split(strline(I), ";")(6)
        Next

        Range(Cells(2, 1), Cells(2, 7).Offset(UBound(RES), 0)) = RES
    Else
        MsgBox " Filen findes ikke"
    End If
End Sub

linien
  Range(Cells(2, 1), Cells(2, 7).Offset(UBound(RES), 0)) = RES

skal ændres til

  Range(Cells(2, 1), Cells(2, 7).Offset(UBound(RES)+1, 0)) = RES

Hej kabbak tak for ovenstående. Den fil jeg har fået at gå ud efter var hentet i ASCII. og kom til at hede 90020.txt vedkommende der sendte mig den er ved at undersøge og den kan expoteres fra axapta i csv format. Ved du om det kan lade sig gøre fra AXAPTA Det er en debitorkonto fil.??

Om den hedder .txt er ligemeget, bare opbygningen er ens

ret
fileToOpen = Application.GetOpenFilename("CSVfiler (*.csv), *.csv")

til

fileToOpen = Application.GetOpenFilename("tekstfiler (*.txt), *.txt")

Skal man ikke specifere at filen ligger i mappen C:\Data\konti\90020.txt
Kan du ikke kort foklare mig hvordan jeg skal indsætte koderne.
Jeg har på nuværende gjordt følgende.
1.Taget en kopi af din kode og indsat i wordpad dokument og rettet koden som du skriver og nu kan jeg kopier hele koden til Excel men hvordan gør jeg.
/Petert

jeg har også rettet koden i toppen fra
Public Sub HentCSVData()
til
Public Sub HenttxtData()
er det korrekt.
/Petert

Ja det er jo bare et navn på makroen, så den kan rettes til hvad det skal være. ;-))

Jeg får først mulighed for at vælge hvinken fil jeg vil have det er meget fint. Men når jeg så vælger min fil 90020.txt får jeg fejlmeddelsen

" run-time error `9`:
Subscript out of range "

Rettet makro

Public Sub HenttxtData()
    Dim strline() As Variant, X As Long, Str As String, fileToOpen As String, RES() As Variant, I As Long
  fileToOpen = "C:\Data\konti\90020.txt" ' ret her hvis det er en anden fil
    If Dir(fileToOpen) <> "" Then
        Open fileToOpen For Input As #1
        Line Input #1, Str
        Line Input #1, Str
        Line Input #1, Str
        Line Input #1, Str
        X = 0
        Do
            Line Input #1, Str
            ReDim Preserve strline(X)
            strline(X) = Split(Str, ";")(0)
            strline(X) = strline(X) & ";" & Split(Str, ";")(1)
            strline(X) = strline(X) & ";" & Split(Str, ";")(6)
            strline(X) = strline(X) & ";" & Split(Str, ";")(7)
            strline(X) = strline(X) & ";" & Split(Str, ";")(8)
            strline(X) = strline(X) & ";" & Split(Str, ";")(9)
            strline(X) = strline(X) & ";" & Split(Str, ";")(10)
            X = X + 1
        Loop Until EOF(1)
        Close #1
        ReDim RES(X - 1, 6)
        For I = 0 To X - 1
            RES(I, 0) = Split(strline(I), ";")(0)
            RES(I, 1) = Split(strline(I), ";")(1)
            RES(I, 2) = Split(strline(I), ";")(2)
            RES(I, 3) = Split(strline(I), ";")(3)
            RES(I, 4) = Split(strline(I), ";")(4)
            RES(I, 5) = Split(strline(I), ";")(5)
            RES(I, 6) = Split(strline(I), ";")(6)
        Next

        Range(Cells(2, 1), Cells(2, 7).Offset(UBound(RES) + 1, 0)) = RES
    Else
        MsgBox " Filen findes ikke"
    End If
End Sub


hvilken linie får du fejl i ??

hvis det er denne linie

Range(Cells(2, 1), Cells(2, 7).Offset(UBound(RES) + 1, 0)) = RES
så fjern + 1

jeg har skiftet koden men får en ny fejl.
Kan jeg ikke sende arket til dig sammen med en kopi af filen.??

jeg har prøvet med og uden + 1 men får fejl
med + 1 får jeg en fejl meddelse og vhvis jeg svare ok hopper den ned i koden til sidst og viser denne
ActiveWorkbook.Save
    Application.Run "afstemning_2.xls!HenttxtData"
    ActiveWorkbook.Save
    Application.Run "afstemning_2.xls!HenttxtData"
    Application.Run "afstemning_2.xls!HenttxtData"

har ikke tid før i aften

kabbak snabela tiscali dot dk

ok jeg sender filerne og forklaring
/Petert

En af de fejl jeg kan se, er at filen er tab separeret og ikke med simikolon.

Kikker videre i aften

Alt det du havde under min kode, det er uden for procedure, så derfor får du fejl.
jeg ved ikke hvad du skal bruge det til, jeg slettede det.

Med hensyn til den tekstfil, så er det ikke en normal datafil, da den slutter med nogen udregninger, så jeg måtte kotte koden af så den stopper ved den tomme linie der er lige over udregningerne.

Her er den ændrede kode


Public Sub HenttxtData()
    Dim strline() As Variant, X As Long, Str As String, fileToOpen As String
    Dim RES() As Variant, I As Long, A As Variant, P As Long
    fileToOpen = "C:\Data\konti\90020.txt" ' ret her hvis det er en anden fil
'    fileToOpen = "C:\test\konto 90020.txt"
    If Dir(fileToOpen) <> "" Then
        Open fileToOpen For Input As #1
        Line Input #1, Str
        Line Input #1, Str
        Line Input #1, Str
        Line Input #1, Str
        X = 0
       
        Do
            Line Input #1, Str
            If Str = "" Then
         
                Exit Do
            End If
            ReDim Preserve strline(X)
            A = Split(Str, vbTab)
            strline(X) = A(0)
            strline(X) = strline(X) & ";" & A(1)
            strline(X) = strline(X) & ";" & A(6)
            strline(X) = strline(X) & ";" & A(7)
            strline(X) = strline(X) & ";" & A(8)
            strline(X) = strline(X) & ";" & A(9)
            strline(X) = strline(X) & ";" & A(10)
            X = X + 1
        Loop Until EOF(1)
        Close #1
       
        P = X - 1
        ReDim RES(P, 6)
       
        For I = 0 To P
            A = Split(strline(I), ";")
            RES(I, 0) = A(0)
            RES(I, 1) = A(1)
            RES(I, 2) = A(2)
            RES(I, 3) = A(3)
            RES(I, 4) = A(4) * 1
                        If A(4) < 0 Then
                RES(I, 5) = A(5) * -1
            Else
                RES(I, 5) = A(5) * 1
            End If
         
      RES(I, 6) = A(6) * 1
        Next

        Range(Cells(2, 1), Cells(2, 7).Offset(P, 0)) = RES
    Else
        MsgBox " Filen findes ikke"
    End If
End Sub

Jeg har slettet alt i den gamle makro og indsat din nye kode.Men får fejlen filen findes ikke. Jeg har filen som jeg sendte til dig i C:\Data\konti\90020
Hvad skal jeg prøve??

Undskyld jeg havde stiret mig blind på det skulle være \konti\konto90020.
Nu begynder det at virke.Hvordan kan det være at når den indlæser starter den med at udligne med det samme så dem der passer sammen er overstreget.
Har du mulighed for at fikse de andre ting jeg skrev om. ??

Prøv at slette området, hvor den skriver i, formater og det hele.

det med overstregning, gjorde den også her første gang, men gjorde det ikke efter en sletning af området.
Den anden kode, kan godt flyttes, men det bliver begge kolonner, de skal stå sammen

ret denne

Range("H2").Resize(I, 2) = valutasum

til

Range("i2").Resize(j, 2) = valutasum

men det betyder at 'Valuta' kommer under 'Saldo i valuta efter afstemning'
og 'Saldo i valuta efter afstemning' kommer under 'Saldo i DK efter afstemning'

Jeg får fejl når jeg kører makroen.
run.time error ´1004´
application-defined or object-defined error
Formålet var at få saldoen både i valuta og dk kr er der en anden måde man kan gøre.
jeg kan bare ændre overskrifterne hvis det hjælper i linje 1.
har du et bud på dette problem
Når jeg henter filen jeg bearbejder viser den fokert i kolonne F med hensyn til alle de beløb i E kolonnen der er - beløb vises som + beløb, men alle de beløb i E kolonnen der er + beløb også vises som + beløb.
Kan man lave det sådan at hvis tallet i E er -(minus) skal Tallet også være -(minus)i F. i samme række??
/Petert

Undskyld har du rette det med - og + tallene i den nye kode??
/tak for hjælpen i dag
/petert

et svar ;-))

mange tak for hjælpen.
/petert