Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1156to1160
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
Inhaltsverzeichnis

Open for... schneller

Open for... schneller
Henrik
Hallo zusammen,
habe folgendes Problem.
Es sollen in einem lokalem Ordner alle *.csv Dateien nacheinander gelesen werden (ca.1500).
In jeder *.csv Datei sollen dann bestimmte strings ersetzt werden. Dieser Weg funktioniert auch.
Mit untenstehenden Code-Teil bin ich aber unzufrieden. Der dauert sehr lange und arbeitet mit einer Hilfskrücke, weil ich es nicht besser weiß.
Die *.csv Datei wird über open for input zeilenweise ausgelesen.
Diese Zeilen werden dann in eine neue Arbeitsmappe geschrieben und diese dann gespeichert.
Gibt es irgendwie die Möglichkeit, die *.csv Datei, die als Input geöffnet ist, direkt zu ändern?
Also keine extra Arbeitsmappe erstellen, sondern in der Art:
1. Öffne Datei
2. Lese erste Zeile, ändere diese und schreib sie gleich zurück
3. nächste zeile lesen, ändern, speichern (schreiben)
...
x. Datei speichern, schließen
Danke für Eure Hilfe
Henrik

Sub Dateioeffnenaendern(DateiNameundPfad)
Dim tmpInhaltZeile, tmpInhaltZeileNeu, AnzahlTrenner, zae1, PfadNeu, NameNeu
Application.ScreenUpdating = False
On Error Resume Next
Open DateiNameundPfad For Input As #1
Workbooks.Add
PfadNeu = Left(DateiNameundPfad, InStr(1, DateiNameundPfad, "Trend_") - 1)
NameNeu = Right(DateiNameundPfad, Len(DateiNameundPfad) - InStr(1, DateiNameundPfad,
"Trend_") + 1)
NameNeu = Replace(NameNeu, "Trend_", "")
ActiveWorkbook.SaveAs Filename:=PfadNeu & NameNeu, FileFormat:=xlCSV, local:=True
zae1 = 1
Do While Not EOF(1)
Line Input #1, tmpInhaltZeile
AnzahlTrenner = UBound(Split(tmpInhaltZeile, ";"))
If AnzahlTrenner 

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

Betreff
Benutzer
Anzeige
Textdatei komplett einlesen per FSO
10.05.2010 18:25:21
NoNet
Hallo Henrik,
ich habe nun nicht Deinen kompletten Code analysiert, aber Du könntest die CSV-Datei auch per FSO öffnen und komplett einlesen, dann die Textersetzungen durchführen und die Datei wieder komplett zurückschreiben.
Hier ein Grundgerüst dafür :
Sub TextFilePerFSOAendern()
Const ForReading = 1, ForWriting = 2
Dim fso, objDatei As Object, strDateiname As String, strText As String
Set fso = CreateObject("Scripting.FileSystemObject")
strDateiname = "C:\temp\DeineDatei.csv" 'Hier den Dateinamen eingeben
Set objDatei = fso.OpenTextFile(FileName, ForReading)    'Datei zum Lesen öffnen
If objDatei.AtEndOfStream Then
strText = ""
Else
strText = objDatei.ReadAll 'kompletten Dateiinhalt einlesen (max. 64 kb !)
strText = Replace(strText, "Hund", "Katze") 'Textinhalt ersetzen
Set objDatei = fso.OpenTextFile(strDateiname, ForWriting, True) 'Datei zum Schreiben ö _
ffnen
objDatei.Write strText 'kompletten Textinhalt wieder zurück schreiben
End If
End Sub
M.E. funktioniert diese FSO-Methode allerdings nur, wenn die CSV-Dateien nicht größer als 64 kb sind - aber das kannst Du sicherlich selbst testen !
Gruß, NoNet
Anzeige
AW: Open for... schneller
11.05.2010 01:49:08
fcs
Hallo Hendrik,
alternativ zum Vorschlag von NoNet kannst du die Daten auch zeilenweise direkt in die neue CSV-Datei schreiben ohne den Umweg über das Workbook. Ich hab es jetzt nicht explizit getestet. Aber es sollte funktionieren.
Gruß
Franz

Sub Dateioeffnenaendern(DateiNameundPfad)
Dim tmpInhaltZeile, tmpInhaltZeileNeu, AnzahlTrenner, PfadNeu, NameNeu
Application.ScreenUpdating = False
On Error Resume Next
Open DateiNameundPfad For Input As #1
PfadNeu = Left(DateiNameundPfad, InStr(1, DateiNameundPfad, "Trend_") - 1)
NameNeu = Right(DateiNameundPfad, Len(DateiNameundPfad) - InStr(1, DateiNameundPfad, _
"Trend_") + 1)
NameNeu = Replace(NameNeu, "Trend_", "")
Open NameNeu For Output As #2
Do While Not EOF(1)
Line Input #1, tmpInhaltZeile
AnzahlTrenner = UBound(Split(tmpInhaltZeile, ";"))
If AnzahlTrenner 

Anzeige
Open for... schneller
11.05.2010 11:36:17
Henrik
Danke euch beiden,
@ NoNet
Eine *.csv-Datei ist im Ø 5 MB groß. Das liegt leider außerhalb deiner 64k Begrenzung.
@ Franz
Dein Code läuft ohne Fehler durch. Hier bin ich aber noch nicht hintergestiegen, ob die Einlese-Datei
und die Ausgabe-Datei ein und die selbe sein müssen!? Wo wird #2 gespeichert?
Jemand noch eine Idee oder Erklärung?

Open "DateimitPfad" for Input as #1                 ->  funktioniert
Open "DateimitPfad" for Output as #2              ->  k.A. müssen #1 und #2 identisch sein?
Line Input #1, "aktuellerZeileninhalt"          ->  funktioniert
Print #2, "aktuellerZeileninhalt"               -> weiß nicht wie ich das prüfen kann.
Close #2                                          -> wohin wird die gespeichert?
Close #1                  -> funktioniert. Alter Textinhalt bleibt jedoch erhalten.
Danke euch
Henrik
Anzeige
@Henrik : Makro funktioniert auch mit 5 MB Datei
11.05.2010 12:49:37
NoNet
Hallo Henrik,
ich korrigiere meine oben gepostete Vermutung : diese Methode funktioniert auch mit "grösseren" Dateien einwandfrei.
Ich habe das Makro eben mit einer 7 MB grossen CSV-Datei (12 Spalten, 60000 Zeilen, Text und Zahlen) getestet : Der Inhalt wurde in ca. 3 Sekunden ersetzt (der Suchbegriff war in über 65.000 Zellen enthalten) !
Das Makro enthielt übrigens noch einen kleinen Fehler : Einen falschen Variablennamn - hier die korrigierte Version :
Sub TextFilePerFSOAendern()
Const ForReading = 1, ForWriting = 2
Dim fso, objDatei As Object, strDateiname As String, strText As String
Set fso = CreateObject("Scripting.FileSystemObject")
strDateiname = "C:\temp\DeineDatei.csv" 'Hier den Dateinamen eingeben
Set objDatei = fso.OpenTextFile(strDateiname, ForReading)  'Datei zum Lesen öffnen
If objDatei.AtEndOfStream Then
strText = ""
Else
strText = objDatei.ReadAll 'kompletten Dateiinhalt einlesen (max. 64 kb !)
strText = Replace(strText, "tag", "day") 'Textinhalt ersetzen
Set objDatei = fso.OpenTextFile(strDateiname, ForWriting, True) 'Datei zum Schreiben ö _
ffnen
objDatei.Write strText 'kompletten Textinhalt wieder zurück schreiben
End If
End Sub
Gruß, NoNet
Anzeige
Funktioniert...Danke
11.05.2010 13:38:06
Henrik
Hallo NoNet,
funktioniert. So kann ich die Laufzeit um ca. die Hälfte verkürzen (statt 10h nur noch 5) :)
Danke dir

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige