Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1884to1888
1884to1888
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

TXT File Export

Forumthread: TXT File Export

TXT File Export
19.05.2022 18:35:49
Jay
Hallo Zusammen,
Ich habe ein Workbook mit 122 Tabellenblättern, wobei nur die Spalten A-C(nur die genutzte Range) von jedem Tabellenblatt (außer die, die ich ausgeschlossen habe) als txt File exportiert werden müssen. Sollten die Spalten A-C leer sein, soll natürlich auch kein txt File für das jeweilige Blatt erstellt werden.
Der Name des txt Files soll aus Tabelle1 Zelle A1 + einer aufsteigenden Nummer für jedes exportierte Blatt erstellt werden: Sprich _1; _2;_3 usw..
Ich stehe leider auf dem Schlauch, bin noch VBA Neuling und hoffe ihr könnt mir helfen.
Wäre vielleicht ganz schön wenn mein angefangener Code genutzt wird bzw. zu etwas zu gebrauchen ist und nichts komplett neues, ich möchte dazu lernen :)

Public Sub Blätter_speichern_txt()
Dim ws As Worksheet
Dim filename As String
Dim my_range As Range
Const Pfad As String = "C:\\Home\Documents\Neuer Ordner\"
Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Worksheets
Select Case ws.Name
Case "Tabelle1", "Tabelle5" 'ausgenommene Blätter
Case Else
filename = Pfad & Worksheets("Tabelle1").Range("A1").Value, &? &".txt"
Open filename For Output As #1
Set my_range =  ?
Print #1
Close #1
Application.ScreenUpdating = True
MsgBox ("TXT File erstellt!")
End Sub
Anzeige

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: TXT File Export
19.05.2022 22:16:24
ralf_b
Versuchs mal damit. Ungetestet.

Option Explicit
Public Sub Blätter_speichern_txt()
Dim ws As Worksheet
Dim filename As String, lineText As String
Dim my_range As Range
Const Pfad As String = "C:\\Home\Documents\Neuer Ordner\"
Dim i As Long, j As Long, cnt As Long
Dim rngA1 As Range
Application.ScreenUpdating = False
Set rngA1 = Worksheets("Tabelle1").Range("A1")
cnt = 1
For Each ws In ThisWorkbook.Worksheets
Select Case ws.Name
Case "Tabelle1", "Tabelle5"              'ausgenommene Blätter
Case Else
filename = Pfad & rngA1.Value & "_" & cnt & ".txt"
cnt = cnt + 1
Open filename For Output As #1
With ws
Set my_range = Intersect(.UsedRange, .Columns("1:3"))
If Not my_range Is Nothing Then
For i = 1 To my_range.Rows.Count
For j = 1 To my_range.Columns.Count
Debug.Print my_range.Cells(i, j)
lineText = IIf(j = 1, "", lineText & ",") & my_range.Cells(i, j)
Next j
Print #1, lineText
Next i
Close #1
MsgBox ("TXT File erstellt!")
End If
End With
End Select
Next
Application.ScreenUpdating = True
End Sub

Anzeige
AW: TXT File Export
19.05.2022 22:17:57
Yal
Hallo Jay,
Anbei mein Versuch.
Ist zwischen die erste und letzte Zeile in A:C eine Zeile leer, wird sie nicht exportiert. Sollltest Du diese leere Zeile trotzdem exportieren wollen, so füge den 4te Parameter im Aufruf von Daten_exportieren auf "True", also
Daten_exportieren ws, "A:C", cPfad & Worksheets("Tabelle1").Range("A1").Value & "_" & Zaehler & ".txt", True
Für ein bessere Lesbarkeit habe ich Anweisungen, die sich wiederholen (LetzteZeile) oder thematisch trennbar sind (Daten_exportieren), als separate Procedure abgelagert.
Zwar habe ich es getestet, es empflieht sich jedoch zuerst statt "Case Else" einen Case mit nur wenigen Blätter zu probieren.
Ich verwende in Daten_exportieren die Bibliothek "Microsoft Scripting Runtime" (Für Objekt FileSystemObject und TextStream). Diese muss in deinem VBA-Editor unter Extras, Verweise... angebunden werden. 

Public Sub Blätter_speichern_txt()
Dim ws As Worksheet
Dim Zaehler As Long
Const cPfad = "C:\Home\Documents\Neuer Ordner\" 'wichtig: abschliessenden "\"
Application.ScreenUpdating = False
Zaehler = 1
For Each ws In ThisWorkbook.Worksheets
Select Case ws.Name
Case "Tabelle1", "Tabelle5" 'ausgenommene Blätter
Case Else
If LetzteZeile(ws, "A:C") Then 'nur wenn nicht leer
Daten_exportieren ws, "A:C", cPfad & Worksheets("Tabelle1").Range("A1").Value & "_" & Zaehler & ".txt"
Zaehler = Zaehler + 1
End If
End Select
Next
Application.ScreenUpdating = True
MsgBox ("Es wurden " & Zaehler - 1 & " txt-Datei(en) erstellt!")
End Sub
Private Sub Daten_exportieren(ByRef Blatt As Worksheet, Bereich As String, DateiName As String, Optional ExportLeereZeile = False)
'Unter Anbindung (Extras, Verweise...) von 'Microsoft Scripting Runtime'
Dim FSO As New FileSystemObject
Dim Datei As TextStream
Dim R
Dim Inhalt As String
Const cTrenn = ";"
Set Datei = FSO.CreateTextFile(DateiName)
For Each R In Blatt.Range(Bereich).Rows("1:" & LetzteZeile(Blatt, Bereich)).Rows
Inhalt = Join(Application.Transpose(Application.Transpose(R)), cTrenn)
If ExportLeereZeile Or Inhalt  String(R.Cells.Count - 1, cTrenn) Then Datei.WriteLine Inhalt
Next
Datei.Close
End Sub
Private Function LetzteZeile(ByRef Blatt As Worksheet, Spalten As String) As Long
Dim Sp
Dim Letzte
For Each Sp In Blatt.Range(Spalten).EntireColumn.Rows(Rows.Count).Cells
Set Letzte = Sp.End(xlUp)
If Letzte.Value  "" And Letzte.Row > LetzteZeile Then LetzteZeile = Letzte.Row
Next
End Function
VG
Yal
Anzeige
AW: TXT File Export
20.05.2022 16:40:37
Jay
Hallo Yal,
Ich danke dir! Läuft alles durch, der Export funktioniert einwandfrei :)
Das einzige Problem das noch besteht, in den Spalten stehen Zahlen es kann z.B. sein, das dort 1,780 steht hier wird nur 1,78 ins txt File exportiert.
Ist es möglich, dass alle Nachkommastellen exportiert werden, selbst wenn diese 0 sind?
Das txt File wird Tabstop getrennt, die Trennung bleibt natürlich gleich egal wieviele Nachkommastellen die jeweilige Zahl hat, jedoch sieht das ganze etwas "unschön" aus wenn die Zahlen mit verschiedenen Nachkommastellen exportiert werden.
Die Daten werden später nochmal eingelesen. Ich möchte hier Fehler vermeiden und daher wenn es geht für alle Daten die gleichen Nachkommastellen exportieren.
Anzeige
AW: TXT File Export
20.05.2022 17:20:56
Yal
Hallo Jay,
Const cTrenn = vbTab
Um die Trennung als Tab zu haben.
Um die Werte mit der orignale Zahlenformat zu exportieren (was nach meiner wenig Mehrwert ergibt), müssten wir auf einem Zelle-bei-Zelle-Modus wie von Ralf.
Beide zusammen ergibt folgendes:

Private Sub Daten_exportieren(ByRef Blatt As Worksheet, Bereich As String, DateiName As String, Optional ExportLeereZeile = False)
'Unter Anbindung (Extras, Verweise...) von 'Microsoft Scripting Runtime'
Dim FSO As New FileSystemObject
Dim Datei As TextStream
Dim R, Z
Dim Inhalt As String
Const cTrenn = vbTab
Set Datei = FSO.CreateTextFile(DateiName)
For Each R In Blatt.Range(Bereich).Rows("1:" & LetzteZeile(Blatt, Bereich)).Rows
Inhalt = ""
For Each Z In R.Cells
Inhalt = Inhalt & cTrenn & Z.Text
Next
If ExportLeereZeile Or Inhalt  String(R.Cells.Count, cTrenn) Then Datei.WriteLine Mid(Inhalt, Len(cTrenn) + 1)
Next
Datei.Close
End Sub
VG
Yal
Anzeige
AW: TXT File Export
20.05.2022 17:42:36
Jay
Yal du bist der Beste! Ich danke dir, so habe ich mir das vorgestellt funktioniert einwandfrei.
AW: TXT File Export
20.05.2022 17:50:52
Yal
Die Lösung von Ralf war auch ganz gut und er hat auch Zeit reingesteckt.
Zwar kann man nur eine Lösung verwenden, aber bedanken...
VG
Yal
AW: TXT File Export
20.05.2022 19:24:05
Jay
Natürlich geht auch ein Dank an Ralf, bin für jede Hilfe Dankar.
Eine kleine Frage hätte ich noch für Zukünftiges. Es kann vorkommen, dass ich etwas in den txt Files ersetzten muss.
Ich könnte dies natürlich durch die Suchen/Ersetzen oder über die Replace Funktion lösen, was in der Vergangenheit auch so funktioniert hat.
Jedoch ist dies manchmal etwas umständlich. Ist es möglich einen Wert über die Replace Funktion nachdem die txt Files exportiert wurden zu suchen/ersetzen?
Ich möchte also nicht die Excel Datei ändern und dann exportieren sondern erst nachdem exportiert wurde die jeweiligen txt Files ändern.
Anzeige
AW: TXT File Export
20.05.2022 19:44:43
Yal
Hallo Jay,
Es kommt darauf an "wo" Du ersetzen möchte (ersetzen auf englisch: replace, also genau das gleiche).
Wenn Du in Excel ersetzst, muss Du nur eine Datei anfassen (Du musst es nicht anschliessend speichern).
Wenn Du in den Textdateien ersetzen möchtest, musst Du eventuell 121 Dateien anfassen... Es wäre umständlicher
Oder Du ersetzst während des Exports... nur "eine" Quelle, Quelle wird dabei nicht geändert.
VG
Yal
Anzeige
AW: TXT File Export
20.05.2022 20:30:38
Jay
Okay, das heißt ich könnte den jetzigen Code abändern und während dem Export der einzelnen Blätter z.B. alle Werte mit 1 durch 2 ersetzten ohne die Quelle zu ändern? Wie würde so etwas aussehen?
Ich hatte nämlich an sowas gedacht, das sämtliche Files im Ordner durchsucht und ersetzt, versuche mich gerade daran.

Public Sub Ersetzten()
Dim FileName As String
Dim FileContent As String
Dim FileFolder As String: FileFolder = ThisWorkbook.Path
Dim objFileSystem As Object: Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Dim objFile As Object
If objFileSystem.FolderExists(FileFolder) Then
For Each objFile In objFileSystem.GetFolder(FileFolder).Files
If Not objFile.Name = ThisWorkbook.Name Then
FileName = objFile.Path
FileContent = GetFile(FileName)
FileContent = VBA.Replace(FileContent, "1", "2")
SaveFile FileName, FileContent
End If
Next objFile
Set objFile = Nothing
Set objFileSystem = Nothing
Else
MsgBox "Kein File gefunden!", vbCritical, FileFolder
End If
End Sub

Anzeige
AW: TXT File Export
21.05.2022 08:03:25
Yal
Nun ja, wenn Du schon einen vollständigen, funktionierenden Code hast, ist es etwas ganz anderes.
Da ist keine weitere Handlung notwendig.
VG
Yal
AW: TXT File Export
21.05.2022 09:29:04
Jay
Da hast du Recht, im Prinzip benötigte ich es nicht unbedingt. Ich habe einfach mal testweise bei deinem Code die Replace Funktion vor dem Export eingefügt. Funktioniert auch, so wie du gesagt hast. Mal sehen welches in Zukunft genutzt wird und praktikabler ist. 

        For Each Z In R.Cells
Inhalt = Inhalt & cTrenn & Replace(Z.Text, "1", "2")

Anzeige
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige