Spalte A
Überschrift
Test2 , Test2 , Test2 , Test2
Test4, Test4, Test4, Test4
Test5, Test5, Test5, Test5
Test7, Test7, Test7, Test7
Test8,Test8,Test8,Test8
Test10,Test10,Test10,Test10
ToText_1
Überschrift
Test2
Test2
Test2
Test2
Test4
'
'
ToText_2
Überschrift
Test2Test2Test2Test2
Test4Test4Test4Test4
Test5Test5Test5Test5
Test7Test7Test7Test7
Test8Test8Test8Test8
Test10Test10Test10Test10
Option Explicit
Sub ToText_1()
' aktive Tabelle
' einzelne Spalte (A) mit Kommata getrennt
Const C_DLM As String = ","
' in eine .txt Datei exportieren
'*****************************************
' alle Zellen ohne leere Zellen
Dim rngA As Range, rngC As Range, c As Range
Dim Sh As Worksheet
Dim strFile As String, iFn As Integer
Dim arrTo() As String, strTo As String, i As Integer
strFile = ThisWorkbook.Path & Application.PathSeparator & "ToText_1.txt"
iFn = FreeFile
Open strFile For Output As #iFn
Set Sh = ActiveSheet
With Sh.Columns("A")
Set c = .ColumnDifferences(.Cells(.Rows.Count))
For Each rngA In c.Areas
For Each rngC In rngA
arrTo = Split(rngC.Value, C_DLM)
For i = LBound(arrTo) To UBound(arrTo)
Print #iFn, Trim(arrTo(i))
Next i
Next rngC
Next rngA
End With
Close #iFn
End Sub
Sub ToText_2()
' aktive Tabelle
' einzelne Spalte (A) mit Kommata getrennt
Const C_DLM As String = ","
' in eine .txt Datei exportieren
'*****************************************
' alle Zellen ohne leere Zellen
Dim rngA As Range, rngC As Range, c As Range
Dim Sh As Worksheet
Dim strFile As String, iFn As Integer
Dim arrTo() As String, strTo As String, i As Integer
strFile = ThisWorkbook.Path & Application.PathSeparator & "ToText_2.txt"
iFn = FreeFile
Open strFile For Output As #iFn
Set Sh = ActiveSheet
With Sh.Columns("A")
Set c = .ColumnDifferences(.Cells(.Rows.Count))
For Each rngA In c.Areas
For Each rngC In rngA
strTo = Replace(rngC.Value, C_DLM, "")
strTo = Replace(strTo, Chr(32), "")
Print #iFn, strTo
Next rngC
Next rngA
End With
Close #iFn
End Sub
oder wie?
|