AW: Bestimmte Zeilen einer CSV auslesen
16.02.2005 13:30:54
EtoPHG
Hallo R,
OK, den Code hab ich nur mal schnell während meiner regulären Arbeit hingebastelt.
Also so wie's aussieht ist Deine Artikelnummer, das 2te Feld (ab Position 3 im Record) und ist 6 stellig. Der folgende Code trägt dem Rechnung, zudem splittet er nun in Gruppen von 50 (d.h. wenn die Artikelnummer in 50er Schritten in den letzten beiden Zahlen wechselt). Ich weiss ja nicht wie Deine Artikelnummer aufgebaut ist, aber mit dem Wert der Variablen iSplittCnt lässt sich dass einstellen.
Option Explicit
Sub EinlesenInTeilen()
Dim sInputFName As String
Dim sOutputFile As String
Dim sOutputFName As String
Dim sInpRecord As String
Dim iLenArtikelNr As Integer
Dim iPosArtikelNr As Integer
Dim iSplittCnt As Integer
Dim iFileNr As Integer
Dim dRecCnt As Double
Dim dArtikelNr As Double
Dim bOutputOpen As Boolean
sInputFName = "C:\TestGesamt.txt" 'Name der Gesamtdatei
sOutputFile = "C:\Teil" 'Erster Teil der gesplitteten Files (wird ergänzt mit Laufnummer und .txt)
iPosArtikelNr = 3 'Position der Artikelnummer im Record
iLenArtikelNr = 6 'Länge der Artikelnummer
iSplittCnt = 50 'Nach N Wert neues Blatt/File
Open sInputFName For Input As #1
While Not EOF(1)
iFileNr = iFileNr + 1
sOutputFName = sOutputFile & Trim(Str(iFileNr)) & ".txt"
Open sOutputFName For Output As #2
If Len(sInpRecord) > 0 Then Write #2, sInpRecord
bOutputOpen = True
Input #1, sInpRecord
While iSplittCnt * iFileNr > Val(Mid(sInpRecord, iPosArtikelNr, iLenArtikelNr)) And Not EOF(1)
Write #2, sInpRecord
Input #1, sInpRecord
Wend
Close #2
bOutputOpen = False
Application.StatusBar = "Output : " & sOutputFName & " Datensätze verarbeitet: " & dRecCnt
Call SplittImport(sOutputFName, iFileNr)
Wend
Close #1
If bOutputOpen Then
Close #2
Call SplittImport(sOutputFName, iFileNr)
End If
End Sub
Sub SplittImport(sFName As String, iNr As Integer)
' Importiert File erstellt neues Blatt
ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count)
Sheets(Worksheets.Count).Activate
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & sFName _
, Destination:=ActiveSheet.Range("A1"))
.Name = "Test" & Trim(Str(iNr))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
.Refresh BackgroundQuery:=False
End With
End Sub
Hoffe das ist jetzt ein Gerüst, mit dem Du weiterarbeiten kannst.
Gruss Hansueli