Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Spaltendaten in Textdatei ausgeben

Spaltendaten in Textdatei ausgeben
28.04.2018 10:48:12
Gig
Hallo, ich brauche eure Hilfe.
Ich möchte Daten einer Spalte von einer Exceldatei (siehe Anhang) in einer Textdatei (.txt) speichern. Für jede einzelne Spalte soll eine eigene Textdatei angelegt werden und in einem bestimmten Verzeichnis abgelegt werden. Also die erste Textdatei soll die Symbole (A AAL AAP AAPL) untereinander ohne Leerzeilen enthalten. Usw...
Der Name der Textdatei soll "Symbole_" + Datum (Datum aus Zeile 3) lauten. Also für die erste Textdatei: Symbole_20170228.txt
Vielen Dank im Voraus.
LG
https://www.herber.de/bbs/user/121335.xlsx

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Spaltendaten in Textdatei ausgeben
28.04.2018 11:23:26
Robert
Hallo Gig,
folgendes Makro erstellt die TXT-Dateien in dem Verzeichnis, in dem die Excel-Datei steht:
Sub TXT_Speichern()
Dim lSp As Long, lZ As Long, n1 As Long, n2 As Long, strDatei As String
lSp = Cells(3, Columns.Count).End(xlToLeft).Column
For n1 = 1 To lSp
lZ = Cells(Rows.Count, n1).End(xlUp).Row
strDatei = "Symbole_" & Cells(3, n1) & ".txt"
Open ThisWorkbook.Path & "\" & strDatei For Output As #1
For n2 = 1 To lZ
If Cells(n2, n1)  "" Then Print #1, Cells(n2, n1)
Next n2
Close #1
Next n1
End Sub
In nachstehender Datei ist das Makro eingebaut:
https://www.herber.de/bbs/user/121336.xlsm
Gruß
Robert
Anzeige
AW: Spaltendaten in Textdatei ausgeben
28.04.2018 13:06:30
Gig
Vielen Dank Robert!
Funktioniert einwandfrei!!
Gerne und Danke für die Rückmeldung (owT)
28.04.2018 14:38:16
Robert
AW: Spaltendaten in Textdatei ausgeben
28.04.2018 11:59:29
Sepp
Hallo Wolfgang,
in ein allgemeines Modul.
Modul Modul1
Option Explicit 
 
Private Enum SORT_ORDER 
  Sort_Unsorted = 0 
  Sort_Ascending = 1 
  Sort_Descending = -1 
End Enum 
 
Sub createTXTFiles() 
  Dim lngCol As Long, lngLast As Long 
  Dim strPath As String, strFile As String, strText As String 
  Dim varIn As Variant, varOUT As Variant 
  Dim ff As Integer 
   
  strPath = "D:\Forum\" 'Ausgabepfad - Anpassen! 
   
  If Right(strPath, 1) <> "\" Then strPath = strPath & "\" 
   
  With Sheets("Tabelle1") 
    For lngCol = 1 To .Cells(2, .Columns.Count).End(xlToLeft).Column 
      lngLast = Application.Max(4, .Cells(.Rows.Count, lngCol).End(xlUp).Row) 
      If Application.CountA(.Range(.Cells(4, lngCol), .Cells(lngLast, lngCol))) > 0 Then 
        varIn = .Range(.Cells(4, lngCol), .Cells(lngLast, lngCol)) 
        varOUT = toArrayUnique(varIn, Sort_Unsorted) 
        If IsArray(varOUT) Then 
          strText = Join(varOUT, vbLf) 
          strFile = strPath & "Symbole_" & .Cells(3, lngCol).Text & ".txt" 
          ff = FreeFile 
          Open strFile For Output As #ff 
          Print #ff, strText; 
          Close #ff 
        End If 
      End If 
    Next 
  End With 
   
End Sub 
 
Private Function toArrayUnique(ByRef Field As Variant, Optional SortOrder As SORT_ORDER = Sort_Ascending) As Variant 
  Dim objArrayList As Object 
  Dim lngR As Long, lngC As Long 
 
  On Error GoTo ErrExit 
 
  Set objArrayList = CreateObject("System.Collections.Arraylist") 
 
  With objArrayList 
    For lngR = Lbound(Field, 1) To Ubound(Field, 1) 
      For lngC = Lbound(Field, 2) To Ubound(Field, 2) 
        If Not .Contains(Trim(Field(lngR, lngC))) Then 
          If Field(lngR, lngC) <> "" Then .Add Trim(Field(lngR, lngC)) 
        End If 
      Next 
    Next 
    If SortOrder <> Sort_Unsorted Then .Sort 
    If SortOrder < Sort_Unsorted Then .Reverse 
    toArrayUnique = .toArray 
  End With 
 
  Exit Function 
ErrExit: 
  toArrayUnique = -1 
End Function 

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media

Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0


 ABCDEF
1Gruß Sepp
2
3

Anzeige

354 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige