Indlæse stor kolon sepereret txt-fil

Det lyder mere som en database-opgave.

Skal du ikke kunne håndtere alle rækker under et?

Du skulle måske kigge på Office 2007. Der kan Excel indeholde lidt over 1 million linier.

Skulle nok være muligt via vba at fortsætte på de næste ark - prøv evt. at sende en håndfuld af textfilen til: pb@supertekst-it.dk

... eller blot her hvor andre kan være med.

Programmet som skal bruge filen bagefter er ikke 2007 kompatibel endnu, så der må ikke være mere end de ca. 65000 linjer på hvert ark.

Jeg har fået dette kode fra et andet spørgsmål, som lidt lød som noget jeg kunne bruge:
"Sub OpenAndSplitFile()
Dim lngRow As Long
Dim test As Integer
Dim txt As String

Const RowsPerSheet = 65000  'Angiv antal rækker per faneblad (Max er 65536)

myFile = Application.GetOpenFilename("Text Files,*.txt")
Application.ScreenUpdating = False
Workbooks.OpenText Filename:=myFile, ConsecutiveDelimiter:=True, Tab:=True, StartRow:=1
With ThisWorkbook
    ActiveSheet.Move after:=.Worksheets(.Worksheets.Count)
End With
ActiveSheet.Name = "Ark2"
Rows(RowsPerSheet + 1 & ":65536").Delete
Application.DisplayAlerts = False
Workbooks.OpenText Filename:=myFile, ConsecutiveDelimiter:=True, Tab:=True, StartRow:=RowsPerSheet + 1
Application.DisplayAlerts = True
ActiveSheet.Move after:=ThisWorkbook.Worksheets(1)
ActiveSheet.Name = "Ark3"
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub"

men det fungere ikke helt, Jeg ved ikke om det er fordi der vil skulle være flere end 2 ark.


Filen er bygget op af emner som dette:

Recipients      : {aaaaa@bbbbb.dk}
RecipientStatus : {550 5.1.1 RESOLVER.ADR.RecipNotFound; not found}
ServerIp        :
Sender          : MicrosoftExchange329f71bc88ae4615bbc36ab6cf41109e@mailsender.
                  biz

Forslag:
Const RækkerPrArk = 65000  'Angiv antal rækker per faneblad (Max er 65536)
Const tekstFilNavn = "Test.txt"        '<<<<---- Justeres
Dim xSti
Dim antalArk, ark, linie, række, linieNr
Sub TekstFilTilArk()                    '<<<---- Start VBA
On Error GoTo fejl

Rem Indlæser sti
    xSti = ActiveWorkbook.Path
    If Right(xst, 1) <> "\" Then
        xSti = xSti + "\"
    End If
   
    linieNr = 0
   
    Application.ScreenUpdating = False
   
Rem Aktuelle ark
    ark = 1
    række = 1
   
Rem Begynd med Ark 1 til lagring
    ActiveWorkbook.Sheets(ark).Activate
   
Rem  - Åbn filen
    Open xSti + tekstFilNavn For Input As #1
    While Not EOF(1)
        Line Input #1, linie
        adskilOpdaterLinie linie, række
        linieNr = linieNr + 1
       
        Application.ScreenUpdating = True
        Application.StatusBar = "Linie: " & CStr(linieNr)
        Application.ScreenUpdating = False
       
        række = række + 1
        If række > RækkerPrArk Then
            Columns.AutoFit
           
Rem Skift til nyt ark
            række = 1
            ActiveWorkbook.Sheets.Add After:=Sheets(ark)
            ark = ark + 1
            ActiveSheet.Name = "Ark" + CStr(ark)
        End If
    Wend
    Close #1
   
    Columns.AutoFit
   
    Application.ScreenUpdating = True
    MsgBox ("Kørsel afsluttet")
    Exit Sub
   
fejl:
    On Error Resume Next
    Close #1
    MsgBox ("Fejl - afbrydes - kontakt udvikler")
End Sub
Private Sub adskilOpdaterLinie(lin, række)    'adskil og indsæt i ark
Dim p, celle, kolonne
    kolonne = 1
    If Right(lin, 1) <> ":" Then
        lin = lin + ":"
    End If
   
    While InStr(lin, ":") > 0
        p = InStr(lin, ":")
        If p > 0 Then
            celle = Left(lin, p - 1)
            ActiveSheet.Cells(række, kolonne) = celle
            kolonne = kolonne + 1
            lin = Mid(lin, p + 1)
        End If
    Wend
End Sub

hej super tekst.
Det var vist lige hvad jeg skulle bruge.
Den skal bare lige også skrive kolonnet ind i arkene i en celle for sig selv, så der er 3 kollonner, men det skulle jeg nok kunne finde ud af.

giver du lige et svar, så kan du få pointene.

Det får du her - skulle det være en anden gang...