' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Sub A_To_Textfile()
Dim strFile As String, strTmp As String
Dim rng As Range, rngC As Range
strFile = "E:\Temp\A.txt" 'Ausgabedatei
On Error Resume Next
Set rng = Columns(1).SpecialCells(xlCellTypeConstants)
On Error GoTo 0
If Not rng Is Nothing Then
Open strFile For Output As #1
For Each rngC In rng
strTmp = rngC.Text
Print #1, rngC.Text
Next
Close #1
End If
End Sub
Sub A_speichern()
Open "c:\test.txt" For Output As #1
With Sheets(1)
Print #1, _
Join(WorksheetFunction.Transpose(.Range(.Cells(1, 1), _
.Cells(Rows.Count, 1).End(xlUp))), vbCrLf)
End With
Close #1
End Sub
Option Explicit
Sub Txt()
Dim i As Long
Dim lngLast As Long
With Sheets(1)
lngLast = .Cells(Rows.Count, 1).End(xlUp).Row
Redim myArray(1 To lngLast)
For i = 1 To lngLast
myArray(i) = IIf(.Cells(i, 1) = "", "", .Cells(i, 1) & "=" & _
IIf(IsDate(.Cells(i, 2)), .Cells(i, 2), _
Replace(Format(.Cells(i, 2), "0.0000"), ",", ".")))
Next
Open "C:\TestMappe.txt" For Output As #1
Print #1, Join(myArray, vbCrLf)
End With
Close #1
End Sub
Option Explicit
Sub Txt()
Dim i As Long
Dim lngLast As Long
With Sheets(1)
lngLast = .Cells(Rows.Count, 1).End(xlUp).Row
Redim myArray(1 To lngLast)
For i = 1 To lngLast
myArray(i) = IIf(.Cells(i, 2) = "", .Cells(i, 1), .Cells(i, 1) & "=" & _
IIf(IsDate(.Cells(i, 2)), .Cells(i, 2), _
IIf(Mid(.Cells(i, 1), 1, 2) = "XK", _
Replace(Format(.Cells(i, 2), "0.000000"), ",", "."), .Cells(i, 2))))
Next
Open "C:\TestMappe.txt" For Output As #1
Print #1, Join(myArray, vbCrLf)
End With
Close #1
End Sub