Office: bestimmte Zellen von Excel in Textfile exportieren

m.knellwolf · 18. April 2015

Hallo zusammen

Ich möchte aus Excel den Inhalt zweier nebeneinander liegenden Spalten (In meinem Fall Spalte R und Spalte S) in eine Textdatei exportieren.
Die Textdatei sollte folgendermaßen editiert sein:

Inhalt Zelle R1
Inhalt Zelle S1
Inhalt Zelle R2
Inhalt Zelle S2
usw..
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Über die Suchfunktion habe ich einen Code gefunden der schon fast das macht was ich möchte, außer eben der richtigen Formatierung.

Da ich des VB nicht mächtig bin, bitte ich euch um hilfe den unten angefügten Code so abzuändern, dass er das macht was ich will...

Danke

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

Sub ExportTextFile()

Dim File, s As Variant
Dim fs, a As Object
Dim ihilf3, NS, NS_new, C, R As Integer
Dim UserRange As Range

'Choose target to export the time valve functions to
File = Application.GetOpenFilename("Text Files (*.txt), *.txt", , "TXT", "Auswahl", True)
If TypeName(File) Like "Boolean" Then
MsgBox "Keine Datei gewählt!", vbInformation
Exit Sub
End If

Debug.Print File(1)

Set UserRange = Application.InputBox(Prompt:="Please Select Range", Title:="Range Select", Type:=8)

Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.OpenTextFile(File(1), 2)
ihilf3 = 3

For R = 1 To UserRange.Rows.Count
s = ""

For C = 1 To UserRange.Columns.Count
s = s & UserRange(R, C) & " "
Next C

a.WriteLine s
Next R

a.Close

End Sub

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

:)

xlph · 20. April 2015

Hallo,

Code:

Sub xlph_ExportToTxt()
Dim strPfad As String
Dim intFF As Integer
Dim rngSelection As Range

Dim avarTemp() As Variant
Dim lngTz As Long
Dim lngTs As Long

Dim astrDaten() As String
Dim lngD As Long

strPfad = ThisWorkbook.Path & "\ExportToTxt.txt"

Set rngSelection = getSelectionRange()

If rngSelection Is Nothing Then Exit Sub

With rngSelection
ReDim astrDaten(1 To .Rows.Count * .Columns.Count)
If .Rows.Count * .Columns.Count = 1 Then
lngD = lngD + 1: astrDaten(lngD) = .Value
Else
avarTemp() = .Value
For lngTz = LBound(avarTemp, 1) To UBound(avarTemp, 1)
For lngTs = LBound(avarTemp, 2) To UBound(avarTemp, 2)
lngD = lngD + 1: astrDaten(lngD) = avarTemp(lngTz, lngTs)
Next
Next
End If
End With

Set rngSelection = Nothing

intFF = FreeFile()
Open strPfad For Output As #intFF
Print #intFF, Join(astrDaten, vbNewLine)
Close #intFF

End Sub

Private Function getSelectionRange() As Range
On Error Resume Next
Set getSelectionRange = Application.InputBox(Prompt:="Please Select Range", Title:="Range Select", Type:=8)
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

m.knellwolf · 20. April 2015

Funktioniert super.

Vielen Dank

m.knellwolf · 30. April 2015

Hallo nochmal

Ich habe meine Tabelle etwas weiterentwickelt. Nun habe ich noch ein Problem. Ich möchte gerne, dass sich gefilterte Zellen nicht exportieren. Kann man das noch irgendwie hinzufügen?

Danke schon mal für die Hilfe

Gruss Martin

m.knellwolf · 30. April 2015

Hallo nochmal

Ich habe meine Tabelle etwas weiterentwickelt. Nun habe ich noch ein Problem. Ich möchte gerne, dass sich gefilterte Zellen nicht exportieren, also nur das was ich gerade angezeigt habe. Kann man das noch irgendwie hinzufügen?

Danke schon mal für die Hilfe

Gruss Martin

xlph · 1. Mai 2015

Code:

Option Explicit

Sub xlph_ExportToTxt()
Dim strPfad As String
Dim intFF As Integer
Dim rngSelection As Range
Dim lngS As Long

Dim avarTemp() As Variant
Dim lngTz As Long
Dim lngTs As Long

Dim astrDaten() As String
Dim lngD As Long

strPfad = ThisWorkbook.Path & "\ExportToTxt.txt"

Set rngSelection = getSelectionRange()

If rngSelection Is Nothing Then Exit Sub

Set rngSelection = getVisibleCells(rngSelection)

If rngSelection Is Nothing Then Exit Sub

With rngSelection
For lngS = 1 To .Areas.Count
With .Areas(lngS)
ReDim Preserve astrDaten(1 To (lngD + .Rows.Count * .Columns.Count))
If .Rows.Count * .Columns.Count = 1 Then
lngD = lngD + 1: astrDaten(lngD) = .Value
Else
avarTemp() = .Value
For lngTz = LBound(avarTemp, 1) To UBound(avarTemp, 1)
For lngTs = LBound(avarTemp, 2) To UBound(avarTemp, 2)
lngD = lngD + 1: astrDaten(lngD) = avarTemp(lngTz, lngTs)
Next
Next
End If
End With
Next
End With

Set rngSelection = Nothing

intFF = FreeFile()
Open strPfad For Output As #intFF
Print #intFF, Join(astrDaten, vbNewLine)
Close #intFF

End Sub

Private Function getSelectionRange() As Range
On Error Resume Next
Set getSelectionRange = Application.InputBox(Prompt:="Please Select Range", Title:="Range Select", Type:=8)
End Function

Private Function getVisibleCells(rngSelection As Range) As Range
On Error Resume Next
Set getVisibleCells = rngSelection.SpecialCells(xlCellTypeVisible)
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

m.knellwolf · 5. Mai 2015

Hallo xlph

Vielen Dank für den Code. Zuerst dachte ich es funktioniert was nicht. Bis ich endlich gemerkt habe das mit aktivem Blattschutz das Makro nicht funktioniert! All good!*grins *grins

thx

Office: bestimmte Zellen von Excel in Textfile exportieren

bestimmte Zellen von Excel in Textfile exportieren

bestimmte Zellen von Excel in Textfile exportieren

bestimmte Zellen von Excel in Textfile exportieren

bestimmte Zellen von Excel in Textfile exportieren - Similar Threads - bestimmte Zellen Excel

Bestimmte Ziffern in Zelle entfernen

Bestimmte Zellen aus geschlossenen Dateien in eine Master Liste hineinkopieren VBA

Excel Formatierung/Textausgabe bei bestimmten Inhalt in anderer Zelle

Ausgeben von bestimmten Zellen einer Zeile

VBA: Bestimmte Zellen von einer Excel Datei in die andere (nach Bedienungen)

Zellen verbinden bei bestimmtem Wert aus Dropdown-Liste

Excel2019 - Adressen von Zellen mit bestimmten Werten finden und wiedergeben