Textdateien Importieren und Filtern

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Nepumuk

Natürlich kan ich die einen auszug aus den Dateien veröffentlichen.

Gruss Rene

20021227;RS23399139 ; 1; 0.720;H;P; 1.000; 4.99;8832 ;WOLLERAU ;FAES AG ;
20021227;RS23396473 ; 1; 6.300;H;P; 7.000; 4.99;8910 ;AFFOLTERN A. A. ;VISCOM ENGINEERING AG ;
20021227;RS23394533 ; 1; 20.740;H;P; 21.000; 4.99;8952 ;SCHLIEREN ;H.A. SCHLATTER AG ;
20021227;2281045176 ; 1; 2.500;H;P; 3.000; 4.99;8953 ;DIETIKON ;SIEMENS SCHWEIZ AG ;
20021227;7180121427 ; 1; 1.280;H;P; 2.000; 4.99;8951 ;FAHRWEID ;SIEMENS SCHWEIZ AG ;
20021227;7180122409 ; 1; 9.260;H;P; 10.000; 4.99;8951 ;FAHRWEID ;SIEMENS SCHWEIZ AG ;
20021227;RS23394023 ; 1; 0.220;H;P; 1.000; 4.99;8953 ;DIETIKON ;SIEMENS SCHWEIZ AG ;
20021227;SPF3082896 ; 1; 4.700;H;P; 5.000; 4.99;8953 ;DIETIKON-FAHRWEID ;SIEMENS SCHWEIZ AG ;
20021227;SPF3083614 ; 1; 3.100;H;P; 4.000; 4.99;8953 ;DIETIKON-FAHRWEID ;SIEMENS SCHWEIZ AG ;
20021227;UM80081088 ; 2; 19.240;H;P; 20.000; 9.98;8951 ;FAHRWEID ;SIEMENS SCHWEIZ AG ;
20021227;TA46331709 ; 1; 88.935;G;S; 0.000; 0.00;8953 ;DIETIKON-FAHRWEID ;SIEMENS SCHWEIZ AG ;91058
20021227;25015074 ; 1; 1.588;U;P; 0.000; 0.00;8954 ;GEROLDSWIL ;BSH HAUSGERAETE AG ;90765
20021227;25015075 ; 1; 6.864;U;P; 0.000; 0.00;8954 ;GEROLDSWIL ;BSH HAUSGERAETE AG ;90765
20021227;25015076 ; 3; 21.576;U;P; 0.000; 0.00;8954 ;GEROLDSWIL ;BSH HAUSGERAETE AG ;90765
20021227;25015077 ; 2; 19.140;U;P; 0.000; 0.00;8954 ;GEROLDSWIL ;BSH HAUSGERAETE AG ;90765
20021227;25021554 ; 3; 30.727;U;P; 0.000; 0.00;8954 ;GEROLDSWIL ;BSH HAUSGERAETE AG ;90765
20021227;PK80190030 ; 1; 27.900;H;P; 28.000; 4.99;8957 ;SPREITENBACH ;ORION-AL-KO AG ;
20021227;RF81101516 ; 1; 4.900;H;P; 5.000; 4.99;9006 ;ST.GALLEN ;INSOFT AG ;
20021227;RS23392839 ; 1; 2.840;H;P; 3.000; 4.99;9006 ;ST. GALLEN ;INSOFT AG ;
20021227;RS23393929 ; 1; 4.660;H;P; 5.000; 4.99;9006 ;ST.GALLEN ;INSOFT AG ;
20021227;RS23399158 ; 1; 8.840;H;P; 9.000; 4.99;9006 ;ST. GALLEN ;INSOFT AG ;
20021227;2281045319 ; 1; 13.000;H;P; 13.000; 4.99;9008 ;ST. GALLEN ;L. KELLENBERGER & CO. AG ;
20021227;RS23393326 ; 1; 2.760;H;P; 3.000; 4.99;9015 ;ST. GALLEN ;ITW GEMA AG ;
20021227;RS23399092 ; 1; 5.200;H;P; 6.000; 4.99;9015 ;ST. GALLEN ;ITW GEMA AG ;

Hallo Rene,
den Pfad zu den Textdateien in der Variablen Pfad musst du noch anpassen.
dein Programm:

Option Explicit
Public Sub Textimport()
Dim HFile As Integer, Pfad As String, Datei As String, Text As String
Dim Zeile As Long, Spalte As Integer, Blaetter As Integer, index As Long
Dim Name_neu As String, Zeile_neu As Long
With Application
.ScreenUpdating = False
Blaetter = .SheetsInNewWorkbook
.SheetsInNewWorkbook = 1
Workbooks.Add
Name_neu = ActiveWorkbook.Name
.SheetsInNewWorkbook = Blaetter
End With
ThisWorkbook.Activate
HFile = FreeFile()
Pfad = "D:\Eigene Dateien\Test\" 'hier den Pfad anpassen!
Datei = Dir(Pfad & "*.txt")
Do Until Datei = ""
Cells.Clear
Zeile = 0
Open Pfad & Datei For Input As HFile
Do Until EOF(HFile)
Input #HFile, Text
Zeile = Zeile + 1
Spalte = 0
If Right(Text, 1) <> ";" Then Text = Text & ";"
Do Until Text = ""
Spalte = Spalte + 1
Cells(Zeile, Spalte) = Mid(Text, 1, InStr(1, Text, ";") - 1)
Text = Mid(Text, InStr(1, Text, ";") + 1)
Loop
Loop
Close
For index = 1 To Zeile
If UCase(Cells(index, 5) = "G") Or UCase(Cells(index, 5) = "U") Then
Zeile_neu = Zeile_neu + 1
Rows(index).Copy Workbooks(Name_neu).Sheets(1).Rows(Zeile_neu)
End If
Next index
Datei = Dir
Loop
Workbooks(Name_neu).Sheets(1).Cells.Columns.AutoFit
ThisWorkbook.Close False
End Sub

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

Textdateien Importieren und Filtern

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread