Anzeige
Archiv - Navigation
812to816
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
812to816
812to816
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Tabellensplitt beim Import einer csv Datei
25.10.2006 10:29:56
Torsten
Guten Morgen,
ich habe folgendes Problem:
Über nachfolgende Routine lese ich eine csv-Datei ein. Funktioniert auch fehlerfrei (dank nochmal an das Forum).
Nun möchte ich die Routine so abändern, dass jeweils eine neues Tabellenblatt angelegt wird, sobald sich in der Spalte E in der csv-Datei der Wert ändert (in der csv-Datei sind die Werte nach Spalte E sortiert).
Hat jemand eine Idee, was ich tun muss?

Function auto_open()
Dim strTxt As String, lngI As Long, myarr
Dim Pfad
Pfad = InputBox("Bitte geben Sie den Pfad inkl. Dateiname und Extension an", "Dateiimport", "*.csv")
Open Pfad For Input As #1
lngI = 1
Do Until EOF(1)
Line Input #1, strTxt
myarr = Split(strTxt, ";")
Range(Cells(lngI, 1), Cells(lngI, UBound(myarr) + 1)) = myarr
lngI = lngI + 1
If lngI > 65536 Then
Sheets.Add after:=ActiveSheet
lngI = 1
End If
Loop
Close #1
End Function

Danke
Torsten

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Tabellensplitt beim Import einer csv Datei
25.10.2006 10:56:30
Rudi
Hallo,

Function auto_open()
Dim strTxt As String, lngI As Long, myarr, WKS As Worksheet
Dim Pfad
Pfad = InputBox("Bitte geben Sie den Pfad inkl. Dateiname und Extension an", "Dateiimport", "*.csv")
Open Pfad For Input As #1
lngI = 1
Set WKS = ActiveSheet
Do Until EOF(1)
Line Input #1, strTxt
myarr = Split(strTxt, ";")
If Cells(lngI - 1, 5) <> myarr(1, 4) Then
Set WKS = Worksheets.Add(after:=WKS)
lngI = 1
End If
With WKS
.Range(.Cells(lngI, 1), .Cells(lngI, UBound(myarr) + 1)) = myarr
lngI = lngI + 1
End With
If lngI > 65536 Then
Set WKS = Sheets.Add(after:=WKS)
lngI = 1
End If
Loop
Close #1
End Function
Gruß
Rudi
Anzeige
AW: Tabellensplitt beim Import einer csv Datei
25.10.2006 12:01:32
Torsten
Hallo Rudi,
erstmal danke.
Bei mir fliegt er aber in der Zeile
If Cells(lngI - 1, 5) myarr(1, 4) Then
raus mit dem Kommentar, dass der liegt.
Was mache ich falsch?
Torsten
AW: Tabellensplitt beim Import einer csv Datei
25.10.2006 12:28:10
Uduuh
Hallo,
wie soll man das verstehen? raus mit dem Kommentar, dass der liegt.
Vermutliche Lösung:
If lngI&gt1 then
If Cells(lngI - 1, 5) &lt&gt myarr(1, 4) Then
Set WKS = Worksheets.Add(after:=WKS)
lngI = 1
End If
End If
Gruß aus’m Pott
Udo

AW: Tabellensplitt beim Import einer csv Datei
25.10.2006 12:36:55
Torsten
Hallo Udo,
zunächst sorry - da muss mir irgendwas beim Kopieren reingerutscht sein. War keine Absicht.
Ich habe den Code jetzt abgeändert in:

Function auto_open()
Dim strTxt As String, lngI As Long, myarr, WKS As Worksheet
Dim Pfad
Pfad = InputBox("Bitte geben Sie den Pfad inkl. Dateiname und Extension an", "Dateiimport", "*.txt")
Open Pfad For Input As #1
lngI = 1
Set WKS = ActiveSheet
Do Until EOF(1)
Line Input #1, strTxt
myarr = Split(strTxt, ";")
If lngI > 1 Then
If Cells(lngI - 1, 5) <> myarr(1, 4) Then
Set WKS = Worksheets.Add(after:=WKS)
lngI = 1
End If
End If
If lngI > 65536 Then
Set WKS = Sheets.Add(after:=WKS)
lngI = 1
End If
Loop
Close #1
End Function

Nun wird die Datei gar nicht mehr importiert.
https://www.herber.de/bbs/user/37651.txt
Anbei einmal die Ursprungsdatei - vielleicht hilft die weiter. Sobald sich die Spalte mit der Überschrift "S" ändert, soll ein neues Tabellenblatt erzeugt werden.
Torsten
Anzeige
AW: Tabellensplitt beim Import einer csv Datei
25.10.2006 13:02:42
Uduuh
Hallo,
der Code ist unvollständig! Das Array wird nicht in ein Blatt geschrieben.

Function auto_open()
Dim strTxt As String, lngI As Long, myarr, WKS As Worksheet
Dim Pfad
Pfad = InputBox("Bitte geben Sie den Pfad inkl. Dateiname und Extension an", "Dateiimport", "*.csv")
Open Pfad For Input As #1
lngI = 1
Set WKS = ActiveSheet
Do Until EOF(1)
Line Input #1, strTxt
myarr = Split(strTxt, ";")
if lngI> 1 then
If Cells(lngI - 1, 5) <> myarr(1, 4) Then
Set WKS = Worksheets.Add(after:=WKS)
lngI = 1
End If
End If
With WKS  'fehlt
.Range(.Cells(lngI, 1), .Cells(lngI, UBound(myarr) + 1)) = myarr  'fehlt
lngI = lngI + 1 'fehlt
End With 'fehlt
If lngI > 65536 Then
Set WKS = Sheets.Add(after:=WKS)
lngI = 1
End If
Loop
Close #1
End Function

Gruß aus’m Pott
Udo

Anzeige

301 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige