VBA - Änderung an TXT-Export-Makro

Hallo allerseits,
ich habe eine Beispieldatei hochgeladen, um mein Anliegen genauer zu erklären:
https://www.herber.de/bbs/user/101847.xlsm
Die Daten auf dem Tabellenblatt sollen als TXT exportiert werden. Dafür haben wir auch ein Makro (Export_txt), welches auch fast einwandfrei funktioniert.
Das Makro trennt die einzelnen Zellen mit einem Semikolon (Konstante sep) und schreibt diese in die Text-Datei. Das passiert auch mit leeren Zellen, solange sie zur UsedRange gehören. Daher wird Zeile 1 in der Text-Datei so dargestellt:

!Data;"";"";"";"";"";"";"";"";"";"";"";""

In der Textdatei muss aber nur !Data stehen. Die Semikolons müssen daher hinterher immer noch rausgelöscht werden. Das würde ich gerne ändern. Entweder soll das Makro selbst !Data schreiben und dann ab Zeile 2 anfangen zu kopieren - oder leere Zellen in Zeile 1 ignorieren.
Ich bin aber leider keine Leuchte in VBA und habe das Makro auch nicht selbst erstellt. Daher hab ich nun ein paar Probleme mit dieser Änderung.
Ich bin für jeden Vorschlag dankbar. Es ist zugegeben nur eine kleines Anliegen (das Makro funktioniert ja) aber ich wollte mich trotzdem mal erkundigen.
Beste Grüße
Josef

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,

Public Sub ExportToTextFile(FName As String, _
Sep As String, SelectionOnly As Boolean, _
AppendData As Boolean)
Dim WholeLine As String
Dim FNum As Integer
Dim RowNdx As Long
Dim ColNdx As Integer
Dim StartRow As Long
Dim EndRow As Long
Dim StartCol As Integer
Dim EndCol As Integer
Dim CellValue As String
Application.ScreenUpdating = False
On Error GoTo EndMacro:
FNum = FreeFile
If SelectionOnly = True Then
With Selection
StartRow = .Cells(1).Row
StartCol = .Cells(1).Column
EndRow = .Cells(.Cells.Count).Row
EndCol = .Cells(.Cells.Count).Column
End With
Else
With ActiveSheet.UsedRange
StartRow = .Cells(1).Row
StartCol = .Cells(1).Column
EndRow = .Cells(.Cells.Count).Row
EndCol = .Cells(.Cells.Count).Column
End With
End If
If AppendData = True Then
Open FName For Append Access Write As #FNum
Else
Open FName For Output Access Write As #FNum
End If
For RowNdx = StartRow To EndRow
WholeLine = ""
For ColNdx = StartCol To EndCol
If Cells(RowNdx, ColNdx).Value  "" Then
CellValue = Cells(RowNdx, ColNdx).Text
WholeLine = WholeLine & CellValue & Sep
End If
Next ColNdx
WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
Print #FNum, WholeLine
Next RowNdx
EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #FNum
End Sub

Gruß
Rudi

Beliebteste Forumthreads (12 Monate)

VBA - Änderung an TXT-Export-Makro

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

305 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA - Änderung an TXT-Export-Makro

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

305 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread