Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1012to1016
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Excel Tabelle als Leerz. getrennte txt speichern
Eddie
Mahlzeit,
ich will gerne meine Tabelle als Leerzeichen getrennte Datei speichern, nur leider macht das prn-Format nur 240 Zeichen in einer zeile .... gibt es einen anderen Weg, umd das layout zu behalten, und dann als leerzeichen getrennte Datei zu speichern ?
Vielleicht kann man auch bei den Leerzeichen noch ein | mit einbauen ... aber das ist nur nen Goodie:-)
gruß Eddie

33
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Excel Tabelle als Leerz. getrennte txt speichern
Tino
Hallo,
hier mal eine Möglichkeit.
Die Tabelle1 wird hier in eine neue Arbeitsmappe kopiert und als Textdatei gespeichert.
Diese Textdatei wird ausgelesen und die Tab- Zeichen durch " | " ausgetauscht.
Die Textdatei liegt danach im Verzeichnis Deiner Exceldatei.
Modul Modul1
Option Explicit 
 
Sub Test() 
Dim TempDatei As Workbook 
Dim strFullName As String 
 
With Application 
  .ScreenUpdating = False 
     
    strFullName = ThisWorkbook.FullName 
    strFullName = Left$(strFullName, InStrRev(strFullName, ".") - 1) & ".txt" 
    'Tabelle in eine neue Mappe kopieren 
    Tabelle1.Copy 
          Set TempDatei = ActiveWorkbook 
      
        .DisplayAlerts = False 
        'als Textdatei speichern durch Tab getrennt 
           TempDatei.SaveAs Filename:=strFullName, FileFormat:= _
               xlText, CreateBackup:=False 
        .DisplayAlerts = True 
        'Textdatei schießen 
        TempDatei.Close False 
    'Textdatei bearbeiten 
    TextDateiBearbeiten (strFullName) 
  .ScreenUpdating = True 
 
End With 
End Sub 
 
Sub TextDateiBearbeiten(sFilename As String) 
  Dim F As Integer 
  Dim sInhalt As String 
  'Inhalt lesen 
    F = FreeFile 
    Open sFilename For Binary As #F 
    sInhalt = Space$(LOF(F)) 
    Get #F, , sInhalt 
    Close #F 
'Tab durch " | " tauschen 
sInhalt = Replace(sInhalt, vbTab, " | ") 
   
'Text zurückschreiben 
  F = FreeFile 
  Open sFilename For Output As #F 
  Print #F, sInhalt 
  Close #F 
 
End Sub 


Gruß Tino

www.VBA-Excel.de


Anzeige
@ Tino - habe da noch eine IDEE/ Wünsch
Eddie
Kann man die version vielleicht so machen, das man einen bestimmten Bereich mit der Maus festlegen kann, wo er das Makto erledigt ?
Mein Problem ist, ich will gerne, das er nur in einen Range diese Sachen erleidigt, und in einen anderen Range die Bedingungen für die Trennung anders ist, nun würde ich gerne nur den Bereich den ich haben will markieren, und dann soll er es entweder automatisch als txt datei speichern, oder halt ich sage Ihn, wie, bzw. wo er es speichern soll .... aber damit könnte ich dann einfach selektieren, was ich haben will, und wie es aussehen soll
Danke und gruß
Eddie
Anzeige
AW: @ Tino - habe da noch eine IDEE/ Wünsch
Tino
Hallo,
ja geht, so müsste es funktionieren.
Modul Modul1
Option Explicit 
 
 
  
Sub Test() 
Dim TempDatei As Workbook 
Dim strFullName As String 
Dim rngSelection As Range 
Set rngSelection = Selection 
With Application 
  .ScreenUpdating = False 
      
    strFullName = ThisWorkbook.FullName 
    strFullName = Left$(strFullName, InStrRev(strFullName, ".") - 1) & ".txt" 
    'Tabelle in eine neue Mappe kopieren 
      
          Set TempDatei = Workbooks.Add 
        rngSelection.Copy TempDatei.Sheets(1).Range("A1") 
        .DisplayAlerts = False 
        'als Textdatei speichern durch Tab getrennt 
           TempDatei.SaveAs Filename:=strFullName, FileFormat:= _
               xlText, CreateBackup:=False 
        .DisplayAlerts = True 
        'Textdatei schießen 
        TempDatei.Close False 
    'Textdatei bearbeiten 
    TextDateiBearbeiten (strFullName) 
  .ScreenUpdating = True 
  
End With 
End Sub 
  
Sub TextDateiBearbeiten(sFilename As String) 
  Dim F As Integer 
  Dim sInhalt As String 
  'Inhalt lesen 
    F = FreeFile 
    Open sFilename For Binary As #F 
    sInhalt = Space$(LOF(F)) 
    Get #F, , sInhalt 
    Close #F 
'Tab durch " | " tauschen 
sInhalt = Replace(sInhalt, vbTab, " | ") 
    
'Text zurückschreiben 
  F = FreeFile 
  Open sFilename For Output As #F 
  Print #F, sInhalt 
  Close #F 
  
End Sub 
 
 


Gruß Tino

Anzeige
AW: @ Tino - habe da noch eine IDEE/ Wünsch
Eddie
hallo Tino...
Jep ... sowas in der Art ist schon nicht schlecht, vielleicht kann man ja noch die Erstellung der Textdatei nicht automatisieren, sondern, sondern das ich mit der Hand das eingeben kannn, und ist es eigentlich machbar,das man den Wert der anstelle des Tabs kommt als Message Box Dialog eingeben kann ?
gruß der Eddie
AW: @ Tino - habe da noch eine IDEE/ Wünsch
Tino
Hallo,
meinst Du so?
Modul Modul1
Option Explicit 
  
  
Dim strTrennZeichen As String 
Sub Test() 
Dim TempDatei As Workbook 
Dim strFullName As String 
Dim rngSelection As Range 
Set rngSelection = Selection 
strTrennZeichen = InputBox("Trennzeichen eingeben!", "Trennzeichen?", "|") 
strTrennZeichen = " " & strTrennZeichen & " " 
With Application 
  .ScreenUpdating = False 
       
    strFullName = ThisWorkbook.FullName 
    strFullName = Left$(strFullName, InStrRev(strFullName, ".") - 1) & ".txt" 
    'Tabelle in eine neue Mappe kopieren 
       
          Set TempDatei = Workbooks.Add 
        rngSelection.Copy TempDatei.Sheets(1).Range("A1") 
        .DisplayAlerts = False 
        'als Textdatei speichern durch Tab getrennt 
           TempDatei.SaveAs Filename:=strFullName, FileFormat:= _
               xlText, CreateBackup:=False 
        .DisplayAlerts = True 
        'Textdatei schießen 
        TempDatei.Close False 
    'Textdatei bearbeiten 
    TextDateiBearbeiten (strFullName) 
  .ScreenUpdating = True 
   
End With 
End Sub 
   
Sub TextDateiBearbeiten(sFilename As String) 
  Dim F As Integer 
  Dim sInhalt As String 
  'Inhalt lesen 
    F = FreeFile 
    Open sFilename For Binary As #F 
    sInhalt = Space$(LOF(F)) 
    Get #F, , sInhalt 
    Close #F 
'Tab durch " | " tauschen 
sInhalt = Replace(sInhalt, vbTab, strTrennZeichen) 
     
'Text zurückschreiben 
  F = FreeFile 
  Open sFilename For Output As #F 
  Print #F, sInhalt 
  Close #F 
   
End Sub 
  
 
 


Gruß Tino

Anzeige
AW: @ Tino - habe da noch eine IDEE/ Wünsch
Eddie
Hallo Tino
genau so meinte ich das, jetzt kann man schneller sagen was als Trennzeichen kommt.....
nur noch die Art der Speicherung, in welcher Datei+Speicherungsort er es speichert würde ich gerne selber auswählen können, und nicht standartmäßig den Dateinamen.txt
gruß Eddie
AW: @ Tino - habe da noch eine IDEE/ Wünsch
Tino
Hallo,
geht auch, als vorgabe wird der Dateiname genommen.
Modul Modul1
Option Explicit 
  
  
Dim strTrennZeichen As String 
Sub Test() 
Dim TempDatei As Workbook 
Dim strFullName As String 
Dim rngSelection As Range 
Set rngSelection = Selection 
strFullName = ThisWorkbook.Name 
strFullName = Left$(strFullName, InStrRev(strFullName, ".") - 1) & ".txt" 
strFullName = Application.GetSaveAsFilename(strFullName, "Textdateien (*.txt), *.txt") 
strTrennZeichen = InputBox("Trennzeichen eingeben!", "Trennzeichen?", "|") 
strTrennZeichen = " " & strTrennZeichen & " " 
With Application 
  .ScreenUpdating = False 
       
     
     
    'Tabelle in eine neue Mappe kopieren 
       
          Set TempDatei = Workbooks.Add 
        rngSelection.Copy TempDatei.Sheets(1).Range("A1") 
        .DisplayAlerts = False 
        'als Textdatei speichern durch Tab getrennt 
           TempDatei.SaveAs Filename:=strFullName, FileFormat:= _
               xlText, CreateBackup:=False 
        .DisplayAlerts = True 
        'Textdatei schießen 
        TempDatei.Close False 
    'Textdatei bearbeiten 
    TextDateiBearbeiten (strFullName) 
  .ScreenUpdating = True 
   
End With 
End Sub 
   
Sub TextDateiBearbeiten(sFilename As String) 
  Dim F As Integer 
  Dim sInhalt As String 
  'Inhalt lesen 
    F = FreeFile 
    Open sFilename For Binary As #F 
    sInhalt = Space$(LOF(F)) 
    Get #F, , sInhalt 
    Close #F 
'Tab durch " | " tauschen 
sInhalt = Replace(sInhalt, vbTab, strTrennZeichen) 
     
'Text zurückschreiben 
  F = FreeFile 
  Open sFilename For Output As #F 
  Print #F, sInhalt 
  Close #F 
   
End Sub 
  
 
 


Gruß Tino

Anzeige
Danke @ Tino & Franz
Eddie
Danke euch beiden für eure IDEEN ... besonders von Tino für seine guten Umsetzungen .. ich denke mal das ich das jetzt so benutzen kann, wenn ich noch fragen haben, oder umsetzungsschwierigkeiten, dann melde ich mich ..
schönen tag noch
gruß der Eddie
Zusatz
Tino
Hallo,
habe Dir noch was eingebaut, solltest Du den Auswahldialog abbrechen.
Modul Modul1
Option Explicit 
  
  
Dim strTrennZeichen As String 
Sub Test() 
Dim TempDatei As Workbook 
Dim strFullName As String 
Dim rngSelection As Range 
Set rngSelection = Selection 
strFullName = ThisWorkbook.Name 
     
    If ThisWorkbook.Saved = True Then 
     strFullName = Left$(strFullName, InStrRev(strFullName, ".") - 1) & ".txt" 
    End If 
 
strFullName = Application.GetSaveAsFilename(strFullName, "Textdateien (*.txt), *.txt") 
 
    If InStr(LCase(strFullName), ".txt") = 0 Then 
        MsgBox "Sie haben den vorgang abgebrochen!" 
        Exit Sub 
    End If 
 
strTrennZeichen = InputBox("Trennzeichen eingeben!", "Trennzeichen?", "|") 
strTrennZeichen = " " & strTrennZeichen & " " 
 
 
With Application 
  .ScreenUpdating = False 
       
     
     
    'Tabelle in eine neue Mappe kopieren 
       
          Set TempDatei = Workbooks.Add 
        rngSelection.Copy TempDatei.Sheets(1).Range("A1") 
        .DisplayAlerts = False 
        'als Textdatei speichern durch Tab getrennt 
           TempDatei.SaveAs Filename:=strFullName, FileFormat:= _
               xlText, CreateBackup:=False 
        .DisplayAlerts = True 
        'Textdatei schießen 
        TempDatei.Close False 
    'Textdatei bearbeiten 
    TextDateiBearbeiten (strFullName) 
  .ScreenUpdating = True 
   
End With 
End Sub 
   
Sub TextDateiBearbeiten(sFilename As String) 
  Dim F As Integer 
  Dim sInhalt As String 
  'Inhalt lesen 
    F = FreeFile 
    Open sFilename For Binary As #F 
    sInhalt = Space$(LOF(F)) 
    Get #F, , sInhalt 
    Close #F 
'Tab durch " | " tauschen 
sInhalt = Replace(sInhalt, vbTab, strTrennZeichen) 
     
'Text zurückschreiben 
  F = FreeFile 
  Open sFilename For Output As #F 
  Print #F, sInhalt 
  Close #F 
   
End Sub 
  
 
 
 
 


Gruß Tino

www.VBA-Excel.de


Anzeige
AW: Zusatz
Eddie
Danke ... nette Goodie :-)
gruß Eddie
AW: Excel Tabelle als Leerz. getrennte txt speichern
fcs
Hallo Eddie,
dann muss man die Daten direkt zeilenweise in eine Text-Datei schreiben.
Die Daten werden dabei so in die Textdatei geschrieben, wie sie in der Exceldatei formatiert sind.
Gruß
Franz
Beispielmakro:

Sub Text_Export()
Dim varDatei, wks As Worksheet
Dim lngZeile As Long, intFF As Integer, strText As String
Dim lngSpalte As Long, intI As Long
Const strSep = " | " 'Trennzeichen zwischen Daten-Spalten
On Error GoTo Fehler
varDatei = Application.GetSaveAsFilename(InitialFileName:="TestExport.txt", _
Filefilter:="Text(*.txt), *.txt", _
Title:="Bitte Namen für Export-Datei wählen oder eingeben und speichern")
If varDatei  False Then
Set wks = ActiveSheet
With wks
intFF = FreeFile()
Open varDatei For Output As #intFF
For lngZeile = 1 To .UsedRange.Row + .UsedRange.Rows.Count - 1
'Wert aus 1. Spalte einlesen
strText = wks.Cells(lngZeile, 1).Text
'Werte aus restlichen Spalten einlesen
For lngSpalte = 1 To .UsedRange.Column + .UsedRange.Columns.Count - 1
strText = strText & strSep & wks.Cells(lngZeile, lngSpalte).Text
Next
'Zeile in Text-Datei schreiben
Print #intFF, strText
Next
Close #intFF
End With
End If
Fehler:
If Err.Number  0 Then
Select Case Err.Number
Case 999 '
Case Else
MsgBox "Fehler: " & Err.Number & vbLf & Err.Description
End Select
End If
End Sub


Anzeige
AW: Excel Tabelle als Leerz. getrennte txt speichern
Eddie
Erst einmal Danke an Tino und Franz,
eure beiden Versionen klappen ja super ... das mit den | Zeichen sollter er ja eigentlich NUR zwischen Daten machen, aber das habe ich ja nicht vorher gesagt :-) und nicht Überall
So sollte es aussehne, wenn ALLE klappen würde, was ich mir dachte :-) s.Zitat

blablatext
blablatext
u.s.w.
case id|| i02 | 025     | 045 | 044 | nu  || _A | _B | _E | _D | _C | _G | _F | _L | _M | _J |  _
_K | i01 | i02 | i13 || remarks/comment
------------------------------------------------------------------------------------------------ _
1   || 000 |  58478  |  T  |  F  |  -  ||  F |  T |  F |  F |  F |  T |  T |  T |  T |  F |   _
T | 000 |  T  |  F  ||
2   || 000 |  7484    |  T  |  F  |  -  ||  F |  F |  F |  T |  F |  T |  F |  T |  F |  F |  _
T | 270 |  T  |  T  ||


Das Probelm ist nur, das ich ja NUR immer sagen kann, was zwischen 2 werten stehen soll, aber er nicht so schlau ist und mir das Layoutmäßig nach der Anzahl der Zeichen wie als prn Datei ausgibt, wobei bei prn ZU viele Leerzeichen vorhanden waren, und das es ja die Begrenzung gab zwecks der Zeichen
Danke erstmal
und lasst es euch noch schmecken
gruß Eddie

Anzeige
AW: Excel Tabelle als Leerz. getrennte txt speichern
Tino
Hallo,
teste mal diese Version.
Modul Modul1
Option Explicit 
 
Sub Test() 
Dim TempDatei As Workbook 
Dim strFullName As String 
 
With Application 
  .ScreenUpdating = False 
     
    strFullName = ThisWorkbook.FullName 
    strFullName = Left$(strFullName, InStrRev(strFullName, ".") - 1) & ".txt" 
    'Tabelle in eine neue Mappe kopieren 
    Tabelle1.Copy 
          Set TempDatei = ActiveWorkbook 
      
        .DisplayAlerts = False 
        'als Textdatei speichern durch Tab getrennt 
           TempDatei.SaveAs Filename:=strFullName, FileFormat:= _
               xlText, CreateBackup:=False 
        .DisplayAlerts = True 
        'Textdatei schießen 
        TempDatei.Close False 
    'Textdatei bearbeiten 
    TextDateiBearbeiten (strFullName) 
  .ScreenUpdating = True 
 
End With 
End Sub 
 
Sub TextDateiBearbeiten(sFilename As String) 
  Dim F As Integer 
  Dim sInhalt As String 
  Dim A As Integer 
  'Inhalt lesen 
    F = FreeFile 
    Open sFilename For Binary As #F 
    sInhalt = Space$(LOF(F)) 
    Get #F, , sInhalt 
    Close #F 
'Tab durch " | " tauschen 
 
For A = 256 To 2 Step -1 
 sInhalt = Replace(sInhalt, String$(A, vbTab), vbTab) 
Next A 
 
sInhalt = Replace(sInhalt, vbTab, " | ") 
   
   
   
'Text zurückschreiben 
  F = FreeFile 
  Open sFilename For Output As #F 
  Print #F, sInhalt 
  Close #F 
 
End Sub 


Gruß Tino

Anzeige
AW: Excel Tabelle als Leerz. getrennte txt speichern
fcs
Hallo Eddie,
hier nochmals eine Verfeinerung des Makros, die die Zelleninhalte mit Leerzeichen auffüllt.
An den Zeichen je Spalte in den Case-Anweisungen muss du ggf. noch ein wenig basteln.
Gruß
Franz

Sub Text_Export()
Dim varDatei, wks As Worksheet, intAnzahlZeichen As Integer, bolLinks As Boolean
Dim lngZeile As Long, intFF As Integer, strText As String
Dim lngSpalte As Long, intI As Long
Const strSep = " | " 'Trennzeichen zwischen Daten-Spalten
On Error GoTo Fehler
varDatei = Application.GetSaveAsFilename(InitialFileName:="TestExport.txt", _
Filefilter:="Text(*.txt), *.txt", _
Title:="Bitte Namen für Export-Datei wählen oder eingeben und speichern")
If varDatei  False Then
Set wks = ActiveSheet
With wks
intFF = FreeFile()
Open varDatei For Output As #intFF
lngZeile = 1
Do
strText = wks.Cells(lngZeile, 1).Text
'ggf. Texte aus weiteren Spalten einlesen
If .Cells(lngZeile, .Columns.Count).End(xlToLeft).Column > 1 Then
For lngSpalte = 2 To .Cells(lngZeile, .Columns.Count).End(xlToLeft).Column
intAnzahlZeichen = Len(wks.Cells(lngZeile, lngSpalte).Text)
strText = strText & strSep & LeerzeichenAuffuellen(strText:=wks.Cells(lngZeile, _
lngSpalte).Text, intZeichen:=intAnzahlZeichen, bolLinks:=True)
Next
End If
Print #intFF, strText
lngZeile = lngZeile + 1
Loop Until InStr(1, .Cells(lngZeile, 1).Value, "case id") > 0
For lngZeile = lngZeile To .UsedRange.Row + .UsedRange.Rows.Count - 1
If InStr(1, .Cells(lngZeile - 1, 1).Value, "case id") > 0 Then
'in Zeile nach Spaltentiteln Zeile mit Bindestrichen einfügen.
strText = String(143, "-")
Else
'Wert aus 1. Spalte einlesen
intAnzahlZeichen = 8
strText = LeerzeichenAuffuellen(strText:=wks.Cells(lngZeile, 1).Text, _
intZeichen:=intAnzahlZeichen, bolLinks:=False)
'Werte aus restlichen Spalten einlesen
For lngSpalte = 2 To 24
Select Case lngSpalte
Case 2, 8
intAnzahlZeichen = 0
bolLinks = True
Case 3
intAnzahlZeichen = 3
bolLinks = False
Case 4
intAnzahlZeichen = 7
bolLinks = False
Case 5, 6, 7
intAnzahlZeichen = 3
bolLinks = True
Case 9 To 19
intAnzahlZeichen = 2
bolLinks = True
Case 20
intAnzahlZeichen = 3
bolLinks = False
Case 21, 22
intAnzahlZeichen = 3
bolLinks = True
Case 23
intAnzahlZeichen = 0
bolLinks = True
Case 24
intAnzahlZeichen = Len(wks.Cells(lngZeile, lngSpalte).Text)
bolLinks = True
Case Else
intAnzahlZeichen = Len(wks.Cells(lngZeile, lngSpalte).Text)
bolLinks = True
End Select
strText = strText & strSep & LeerzeichenAuffuellen(strText:=wks.Cells(lngZeile, _
lngSpalte).Text, intZeichen:=intAnzahlZeichen, bolLinks:=bolLinks)
Next
End If
'Zeile in Text-Datei schreiben
Print #intFF, strText
Next
Close #intFF
End With
End If
Fehler:
If Err.Number  0 Then
Select Case Err.Number
Case 999 '
Case Else
MsgBox "Fehler: " & Err.Number & vbLf & Err.Description
End Select
End If
End Sub
Function LeerzeichenAuffuellen(strText As String, intZeichen As Integer, _
Optional bolLinks As Boolean = True)
'Text entsprechend Wert von intZeichen mit Leerzeichen auffüllen
Dim lngLaenge As Integer, strLeer As String
If Len(strText) > intZeichen Then
'Überzählige Zeichen abschneiden
LeerzeichenAuffuellen = Left(strText, intZeichen)
Else
'Anzahl erforderliche Leerzeichen bestimmen
If Len(strText) 


AW: Excel Tabelle als Leerz. getrennte txt speichern
Eddie
Hallo Franz...
ich habe irgendwie folgendes Sympton
Das ist in Excel drin:

case id	i02	025	044	nu	_A	_B	_K	i01	i02	i13	remarks/comment
------------------------------------------------------------------------------------------------ _
1	000	F	F	-	F	F	T	000	T	F
2	000	T	F	-	F	F	T	400	T	T


und das bekomme ich raus


case id |  | 025 |     044 | nu  | _A  | _B  |  | i0 | i0 | i1 | re |    |    |    |    |    |  _
------------------------------------------------------------------------------------------------ _
1 |  |   F |       F | -   | F   | F   |  | 00 | T  | F  |    |    |    |    |    |    |  _
2 |  |   T |       F | -   | F   | F   |  | 40 | T  | T  |    |    |    |    |    |    |  _
|  |     |         |     |     |     |  |    |    |    |    |    |    |    |    |    |  _
|  |     |         |     |     |     |  |    |    |    |    |    |    |    |    |    |  _
|  |     |         |     |     |     |  |    |    |    |    |    |    |    |    |    |  _
|  |     |         |     |     |     |  |    |    |    |    |    |    |    |    |    |  _


und wenn ich die ---------------------------------------------- Zeile Lösche, dann kommt das nur noch raus:


case id |  | 025 |     044 | nu  | _A  | _B  |  | i0 | i0 | i1 | re |    |    |    |    |    |  _
------------------------------------------------------------------------------------------------ _
2 |  |   T |       F | -   | F   | F   |  | 40 | T  | T  |    |    |    |    |    |    |  _
|  |     |         |     |     |     |  |    |    |    |    |    |    |    |    |    |  _
|  |     |         |     |     |     |  |    |    |    |    |    |    |    |    |    |  _
|  |     |         |     |     |     |  |    |    |    |    |    |    |    |    |    |  _
|  |     |         |     |     |     |  |    |    |    |    |    |    |    |    |    |  _


wie du siehst, sind manche spalten verschwunden .. vielleicht liegt es deswegen, weil sie als text unf nicht als standart definiert sind ? Vielleicht hat er auch Probleme mit den Wort i0x ?
Anbei ist auch mal die Version von MIR
https://www.herber.de/bbs/user/55921.xls
gruß Eddie

AW: Excel Tabelle als Leerz. getrennte txt speichern
fcs
Hallo edie,
dadurch, dass der Aufbau deiner bisherigen Text-beispiel völlig anders war als jetzt in deiner Beispieldatei konnte kein gutes Ergebnis herauskommen ohne Anpassung des Makros.
Gruß
Franz

Die Datei https://www.herber.de/bbs/user/55924.xls wurde aus Datenschutzgründen gelöscht


AW: Excel Tabelle als Leerz. getrennte txt speichern
Eddie
Hall Franz ..
das makro macht ja schon einen schönen output .. nur wenn entw. die Datengröße länger las 3 Zeichen (nicht 000 sonder 00078454) dann gibt er nur die 3 Nullen aus ...
und wenn man Unter den 2 Bsp. Daten-Zeilen nun irgendetwas einfügt .. egal wo dann macht er die | Striche auch dort in Unmengen .. wenn er aber erkennen würe das 1. das wenn man z:b. eine Leerzeile hat und danach nur ein Text Ist, der nicht mit | getrennt werden müsste bzw. die ZellenSpaltengröße automat. erkennt, dann wäre es schon richtig Hilfreich für mich ... ich wünsch dann erstmal nen guten Hunger
gruß Eddie
AW: Excel Tabelle als Leerz. getrennte txt speichern
fcs
Hallo Eddie,
ein sollches Makro, das eine Excel-Tabelle in eine Text-Datei wandelt, muss immer speziell auf den Aufbau der Tabelle zugeschnitten sein.
Wenn die Zahlen in einer der Spalten nicht 3 Stellen haben sondern 8 dann muss du die Angabe (AnzahlZeichen) für die betreffende Spalte im Code anpassen.
Wenn nach der tabellarischen Darstellung der Daten nochmals Daten kommen, die ohne Trennzeichen dargestellt werden sollen, dann müssen in der For-Schleife entsprechende Prüfungen eingebaut werden, die bei entsprechendem Ergebnis die Ausgabe der Daten anders gestalten. D.h. bei dir z.b. die For-Schleife verlassen und die restlichen Daten so verarbeiten wie die Zeilen vor der Zeile mit den Spaltentiteln.
Aber ohne Bespieldatei, die die Datenformate und den Datenaufbau in der Tabelle komplett wiedergibt, kann man keine vollständige Lösung erarbeiten.
Gruß
Franz
neue Bsp. Datei erstellt ...
Eddie
Hallo Franz, ich habe nun mal eine größere Testdatei erstellt, wo so ein paar extremfälle drin sind ... ich hoffe du kannst damit etwas anfangen, bzw. hast eine IDEE zu meiner Problematik
https://www.herber.de/bbs/user/55981.xls
gruß und guten Hunger...
Eddie
AW: neue Bsp. Datei erstellt ...
fcs
Hallo Eddie,
ich hab jetzt die Prozedur so umgestrickt, dass die Texte alternierend ohne Trennzeichen und mit Trennzeichen augegeben werden.
Ein Bereich mit Trennzeichen beginnt immer vor einer Zeile mit "case id" und ended vor der nachfolgenden leeren Zeile.
Gruß
Franz

Sub Text_Export()
Dim varDatei, wks As Worksheet, intAnzahlZeichen As Integer, bolLinks As Boolean
Dim lngZeile1 As Long, lngZeileE As Long, lngZ As Long
Dim lngZeile As Long, intFF As Integer, strText As String
Dim lngSpalte As Long, intI As Long, arrBreite() As Long
Const strSep = " | " 'Trennzeichen zwischen Daten-Spalten
On Error GoTo Fehler
varDatei = Application.GetSaveAsFilename(InitialFileName:="TestExport.txt", _
Filefilter:="Text(*.txt), *.txt", _
Title:="Bitte Namen für Export-Datei wählen oder eingeben und speichern")
If varDatei  False Then
Set wks = ActiveSheet
With wks
intFF = FreeFile()
Open varDatei For Output As #intFF
lngZeileLast = .UsedRange.Row + .UsedRange.Rows.Count - 1
For lngZeile = 1 To lngZeileLast
lngZeile1 = lngZeile
'nächste Tabelle suchen ("case id" steht in Spalte A)
Do
lngZeile = lngZeile + 1
If lngZeile >= lngZeileLast Then Exit Do
Loop Until InStr(1, .Cells(lngZeile, 1).Value, "case id") > 0
lngZeileE = lngZeile - 2
'Nicht Tabellentexte in Datei schreiben
Do
strText = wks.Cells(lngZeile1, 1).Text
'ggf. Texte aus weiteren Spalten einlesen
If .Cells(lngZeile1, .Columns.Count).End(xlToLeft).Column > 1 Then
For lngSpalte = 2 To .Cells(lngZeile1, .Columns.Count).End(xlToLeft).Column
intAnzahlZeichen = Len(wks.Cells(lngZeile1, lngSpalte).Text)
strText = strText & strSep & LeerzeichenAuffuellen(strText:=wks.Cells(lngZeile1,  _
_
lngSpalte).Text, intZeichen:=intAnzahlZeichen, bolLinks:=True)
Next
End If
Print #intFF, strText
lngZeile1 = lngZeile1 + 1
Loop Until lngZeile1 > lngZeileE
'Anfang Tabelle setzen
lngZeile1 = lngZeileE + 1
'Ende Tabelle suchen (nächste leere Zeile)
lngZeileE = lngZeile1 + 1
Do
lngZeile = lngZeile + 1
If lngZeile >= lngZeileLast Then Exit Do
Loop Until IsEmpty(.Cells(lngZeile, 1)) Or IsEmpty(.Cells(lngZeile, 2))
lngZeileE = lngZeile - 1
'Letzte Spalte in Titelzeile ermitteln
lngSpalteMax = .Cells(lngZeile1 + 1, .Columns.Count).End(xlToLeft).Column
ReDim arrBreite(1 To lngSpalteMax)
'Spalten Breiten ermitteln und in Array speichern
For lngSpalte = 1 To lngSpalteMax
For lngZ = lngZeile1 To lngZeileE
If LCase(.Cells(lngZ, lngSpalte).Text) = "remarks/comment" Then
arrBreite(lngSpalte) = 999
Exit For
Else
If Len(.Cells(lngZ, lngSpalte).Text) > arrBreite(lngSpalte) Then
arrBreite(lngSpalte) = Len(.Cells(lngZ, lngSpalte).Text)
End If
End If
Next
Next
'Zeilen des Tabellenbereichs einlesen
For lngZ = lngZeile1 To lngZeileE
'Wert aus 1. Spalte einlesen
intAnzahlZeichen = arrBreite(1)
strText = LeerzeichenAuffuellen(strText:=.Cells(lngZ, 1).Text, _
intZeichen:=intAnzahlZeichen, bolLinks:=IsNumeric(.Cells(lngZ, 1).Text))
'Werte aus restlichen Spalten einlesen
For lngSpalte = 2 To lngSpalteMax
If arrBreite(lngSpalte)  999 Then
intAnzahlZeichen = arrBreite(lngSpalte)
Else
intAnzahlZeichen = Len(wks.Cells(lngZ, lngSpalte).Text)
End If
bolLinks = IsNumeric(.Cells(lngZeile, 1).Text)
strText = strText & strSep & LeerzeichenAuffuellen(strText:=wks.Cells(lngZ, _
lngSpalte).Text, intZeichen:=intAnzahlZeichen, bolLinks:=bolLinks)
Next
'Zeile in Text-Datei schreiben
Print #intFF, strText
Next
lngZeile = lngZeileE
Next
Close #intFF
End With
End If
Fehler:
If Err.Number  0 Then
Select Case Err.Number
Case 999 '
Case Else
MsgBox "Fehler: " & Err.Number & vbLf & Err.Description
End Select
End If
End Sub
Function LeerzeichenAuffuellen(strText As String, intZeichen As Integer, _
Optional bolLinks As Boolean = True)
'Text entsprechend Wert von intZeichen mit Leerzeichen auffüllen
Dim lngLaenge As Integer, strLeer As String
If Len(strText) > intZeichen Then
'Überzählige Zeichen abschneiden
LeerzeichenAuffuellen = Left(strText, intZeichen)
Else
'Anzahl erforderliche Leerzeichen bestimmen
If Len(strText) 


AW: neue Bsp. Datei erstellt ...
Eddie
Guten Morgen Franz
Kannst du vielleicht das noch so machen, das die Zeile wo case id steht erst mir Trennzeichen ausgefüllt wird, und nicht schon die darüber ?
Und kann man vielleicht noch beim textexport noch eine Zeile nach der case id einfügen, so als trennzeile ... wo nur ein ------------- drin ist .. vielleicht auch so lang wie die case id Zeile lang ist ?
Wenn das nicht so einfach ist, würde ich mich aber über die Zeilenänderung des Startes der Trennzeichen freuen
Achso .. es muss ja immer etwas in der Spalte A stehen, ansonsten schreibt er mir ja ein Trennzeichen, weil in B34 "Das ist ein Bsp. Text" macht er mir vorher noch ein Trennzeichen beim export .. aber das stört mich nicht so, wollte nur fragen ob das so von der Funkt. ist ?
gruß und Danke
der Eddie
AW: neue Bsp. Datei erstellt ...
fcs
Hallo Eddie,
ich hab die Prozedur nochmals an deine Wünsche angepasst.
Für Texte außerhalb der Tabellenbereiche wird jetzt als Trennzeichen " " statt " | "verwendet.
Gruß
Franz

Sub Text_Export()
Dim varDatei, wks As Worksheet, intAnzahlZeichen As Integer, bolLinks As Boolean
Dim lngZeile1 As Long, lngZeileE As Long, lngZ As Long
Dim lngZeile As Long, intFF As Integer, strText As String
Dim lngSpalte As Long, intI As Long, arrBreite() As Long
Const strSep = " | " 'Trennzeichen zwischen Daten-Spalten in Tabellenabschnitten
Const strSep2 = " " 'Trennzeichen zwischen Daten-Spalten außerhalb Tabellenabschnitten
On Error GoTo Fehler
varDatei = Application.GetSaveAsFilename(InitialFileName:="TestExport.txt", _
Filefilter:="Text(*.txt), *.txt", _
Title:="Bitte Namen für Export-Datei wählen oder eingeben und speichern")
If varDatei  False Then
Set wks = ActiveSheet
With wks
intFF = FreeFile()
Open varDatei For Output As #intFF
lngZeileLast = .UsedRange.Row + .UsedRange.Rows.Count - 1
For lngZeile = 1 To lngZeileLast
lngZeile1 = lngZeile
'nächste Tabelle suchen ("case id" steht in Spalte A)
Do
lngZeile = lngZeile + 1
If lngZeile >= lngZeileLast Then Exit Do
Loop Until InStr(1, .Cells(lngZeile, 1).Value, "case id") > 0
lngZeileE = lngZeile - 1
'Nicht Tabellentexte in Datei schreiben
Do
strText = wks.Cells(lngZeile1, 1).Text
'ggf. Texte aus weiteren Spalten einlesen
If .Cells(lngZeile1, .Columns.Count).End(xlToLeft).Column > 1 Then
For lngSpalte = 2 To .Cells(lngZeile1, .Columns.Count).End(xlToLeft).Column
intAnzahlZeichen = Len(wks.Cells(lngZeile1, lngSpalte).Text)
strText = strText & strSep2 _
& LeerzeichenAuffuellen(strText:=wks.Cells(lngZeile1, _
lngSpalte).Text, intZeichen:=intAnzahlZeichen, bolLinks:=True)
Next
End If
Print #intFF, strText
lngZeile1 = lngZeile1 + 1
Loop Until lngZeile1 > lngZeileE
'Anfang Tabelle setzen
lngZeile1 = lngZeileE + 1
'Ende Tabelle suchen (nächste leere Zeile)
lngZeileE = lngZeile1 + 1
Do
lngZeile = lngZeile + 1
If lngZeile >= lngZeileLast Then Exit Do
Loop Until IsEmpty(.Cells(lngZeile, 1)) Or IsEmpty(.Cells(lngZeile, 2))
lngZeileE = lngZeile - 1
'Letzte Spalte in Titelzeile ermitteln
lngSpalteMax = .Cells(lngZeile1, .Columns.Count).End(xlToLeft).Column
ReDim arrBreite(1 To lngSpalteMax)
'Spalten Breiten ermitteln und in Array speichern
For lngSpalte = 1 To lngSpalteMax
For lngZ = lngZeile1 To lngZeileE
If LCase(.Cells(lngZ, lngSpalte).Text) = "remarks/comment" Then
arrBreite(lngSpalte) = 999
Exit For
Else
If Len(.Cells(lngZ, lngSpalte).Text) > arrBreite(lngSpalte) Then
arrBreite(lngSpalte) = Len(.Cells(lngZ, lngSpalte).Text)
End If
End If
Next
Next
'Zeilen des Tabellenbereichs einlesen
For lngZ = lngZeile1 To lngZeileE
'Wert aus 1. Spalte einlesen
intAnzahlZeichen = arrBreite(1)
strText = LeerzeichenAuffuellen(strText:=.Cells(lngZ, 1).Text, _
intZeichen:=intAnzahlZeichen, bolLinks:=IsNumeric(.Cells(lngZ, 1).Text))
'Werte aus restlichen Spalten einlesen
For lngSpalte = 2 To lngSpalteMax
If arrBreite(lngSpalte)  999 Then
intAnzahlZeichen = arrBreite(lngSpalte)
Else
intAnzahlZeichen = Len(wks.Cells(lngZ, lngSpalte).Text)
End If
bolLinks = IsNumeric(.Cells(lngZeile, 1).Text)
strText = strText & strSep & LeerzeichenAuffuellen(strText:=wks.Cells(lngZ, _
lngSpalte).Text, intZeichen:=intAnzahlZeichen, bolLinks:=bolLinks)
Next
'Zeile in Text-Datei schreiben
Print #intFF, strText
If lngZ = lngZeile1 Then
'Zeile mit "-" nach 1. Zeile der Tabelle einfügen
'Gesamt-Anzahl Zeichen in den Spalten ermitteln
intI = 0
intI = arrBreite(1)
For lngSpalte = 2 To lngSpalteMax
If arrBreite(lngSpalte) = 999 Then
intI = intI + Len(strSep) + Len("remarks/comment")
Else
intI = intI + Len(strSep) + arrBreite(lngSpalte)
End If
Next
strText = String(intI, "-")
Print #intFF, strText
End If
Next
lngZeile = lngZeileE
Next
Close #intFF
End With
End If
Fehler:
If Err.Number  0 Then
Select Case Err.Number
Case 999 '
Case Else
MsgBox "Fehler: " & Err.Number & vbLf & Err.Description
End Select
End If
End Sub
Function LeerzeichenAuffuellen(strText As String, intZeichen As Integer, _
Optional bolLinks As Boolean = True)
'Text entsprechend Wert von intZeichen mit Leerzeichen auffüllen
Dim lngLaenge As Integer, strLeer As String
If Len(strText) > intZeichen Then
'Überzählige Zeichen abschneiden
LeerzeichenAuffuellen = Left(strText, intZeichen)
Else
'Anzahl erforderliche Leerzeichen bestimmen
If Len(strText) 


AW: neue Bsp. Datei erstellt ...
Eddie
Hallo Franz, klappt ja wirklich Super, traue mich ja gar nicht mehr etwas zu sagen :-)
Habe da aber noch etwas entdeckt .. wenn ich nun bei meinen Testschritten am ende nichts mehr stehen habe

2	000	T	F	-	F	F	T	400	T	T


... also danach keinen text mehr habe, dann kann er wohl nicht mehr erkennen, wo das ende ist, und trennt mir das nicht in der txt datei mehr ... ist ja nichts schlimmes, muss halt danach immer noch einen text eintippen
gruß Eddie

DANKE Franz
Eddie
Nochmals der Text von eben ...
Hallo Franz, klappt ja wirklich Super, traue mich ja gar nicht mehr etwas zu sagen :-)
Habe da aber noch etwas entdeckt .. wenn ich nun bei meinen Testschritten am ende nichts mehr stehen habe

2	000	T	F	-	F	F	T	400	T	T 


... also danach keinen text mehr habe, dann kann er wohl nicht mehr erkennen, wo das ende ist, und trennt mir das nicht in der txt datei mehr ... ist ja nichts schlimmes, muss halt danach immer noch einen text eintippen
Habe nun noch etwas ... brauche noch eine abgewandelte Version, was mir diesen Text kreieren soll


|| Schritt 1 1 || Schritt n+1 || Hinweise
Voller I/O test                      ||    X   ||          ||
Analyse                              ||        ||     X    ||
Klassen                              ||        ||          ||
Testfall                             ||        ||          || Nur Programme
Ladetest                             ||        ||          ||


In Excel hätte ich nur in spalte A die Voller I/O Test bis Ladetest Daten, und in Spalte B bis XXX die Anzahl der Schritte ..... und dann noch eine Spalte Hinweise
Anschließend kann man dann den jeweiligen Schritt mit einen Kreuz den Fall zuweisen.... würde gerne nur diese Fkt. aus Excel in einen Testsheet mit einbauen .. und das die Trennung der einzelnen Spalten auch so ausgegeben wird :-)
gruß Eddie

AW: DANKE Franz
fcs
Hallo Eddie,
hier die abgewandelte Version, um die Schritte-Tabelle als Text auszugeben.
Gruß
Franz

Sub Text_Export_Schritte()
Dim varDatei, wks As Worksheet, intAnzahlZeichen As Integer
Dim lngZeileLast As Long, lngSpalteMax As Long
Dim lngZeile As Long, intFF As Integer, strText As String
Dim lngSpalte As Long, arrBreite() As Long
Const strSep = "||" 'Trennzeichen zwischen Daten-Spalten
On Error GoTo Fehler
varDatei = Application.GetSaveAsFilename(InitialFileName:="TestExport.txt", _
Filefilter:="Text(*.txt), *.txt", _
Title:="Bitte Namen für Export-Datei wählen oder eingeben und speichern")
If varDatei  False Then
Set wks = ActiveSheet
With wks
intFF = FreeFile()
Open varDatei For Output As #intFF
lngZeileLast = .UsedRange.Row + .UsedRange.Rows.Count - 1
'Letzte Spalte in Titelzeile ermitteln
lngSpalteMax = .Cells(1, .Columns.Count).End(xlToLeft).Column
ReDim arrBreite(1 To lngSpalteMax)
'Spalten Breiten ermitteln und in Array speichern
For lngSpalte = 1 To lngSpalteMax
For lngZeile = 1 To lngZeileLast
If Len(.Cells(lngZeile, lngSpalte).Text) > arrBreite(lngSpalte) Then
arrBreite(lngSpalte) = Len(.Cells(lngZeile, lngSpalte).Text)
End If
Next
arrBreite(lngSpalte) = arrBreite(lngSpalte) + 2 '2 zusätlich für Leerzeichen
Next
'Zeilen der Tabelle einlesen
For lngZeile = 1 To lngZeileLast
'Wert aus 1. Spalte einlesen
intAnzahlZeichen = arrBreite(1)
strText = LeerzeichenAuffuellen2(strText:=.Cells(lngZeile, 1).Text, _
intZeichen:=intAnzahlZeichen)
'Werte aus Spalten für Schritte einlesen
For lngSpalte = 2 To lngSpalteMax - 1
intAnzahlZeichen = arrBreite(lngSpalte)
strText = strText & strSep & LeerzeichenX(strText:=wks.Cells(lngZeile, _
lngSpalte).Text, intZeichen:=intAnzahlZeichen)
Next
'Hinweise einlesen
intAnzahlZeichen = arrBreite(lngSpalteMax)
strText = strText & strSep & LeerzeichenAuffuellen2(strText:=" " _
& .Cells(lngZeile, lngSpalteMax).Text, intZeichen:=intAnzahlZeichen)
'Zeile in Text-Datei schreiben
Print #intFF, strText
'TrennZeile mit "-" nach Zeile der Tabelle einfügen
strText = String(arrBreite(1), "-")
For lngSpalte = 2 To lngSpalteMax
strText = strText & strSep & String(arrBreite(lngSpalte), "-")
Next
Print #intFF, strText
Next
Close #intFF
End With
End If
Fehler:
If Err.Number  0 Then
Select Case Err.Number
Case 999 '
Case Else
MsgBox "Fehler: " & Err.Number & vbLf & Err.Description
End Select
End If
End Sub
Function LeerzeichenAuffuellen2(strText As String, intZeichen As Integer)
'Text entsprechend Wert von intZeichen mit Leerzeichen auffüllen
Dim strLeer As String
If Len(strText) > intZeichen Then
'Überzählige Zeichen abschneiden
LeerzeichenAuffuellen2 = Left(strText, intZeichen)
Else
'Anzahl erforderliche Leerzeichen bestimmen
If Len(strText)  intZeichen Then
'Überzählige Zeichen abschneiden
LeerzeichenX = Left(strText, intZeichen)
Else
'Anzahl erforderliche Leerzeichen bestimmen
intLeer = intZeichen - Len(strText)
'Leerzeichen vor und nach dem Text einfügen
If intLeer Mod 2 = 0 Then 'gerade Anzahl leerzeichen
LeerzeichenX = String(intLeer / 2, " ") & strText & String(intLeer / 2, " ")
Else 'ungerade Anzahl leerzeichen
LeerzeichenX = String(Int(intLeer / 2), " ") & strText & String(Int(intLeer / 2) + 1, " ") _
End If
End If
End Function


AW: DANKE Franz
Eddie
vielen Dank .... klappt ja super ... muss mich nur dran gewöhnen, das ich immer von Zeile 1 anfange :-)
AW: neue Bsp. Datei erstellt ...
fcs
Hallo Eddie,
das beschriebene Phänomen konnte ich nicht nachvollziehen.
2 Kleinigkeiten in der Zeilensteuerung sind mir aber noch aufgefallen. Die angepasten/ergänzten Zeilen hab ich mit '### markiert.
Gruß
Franz

Sub Text_Export()
Dim varDatei, wks As Worksheet, intAnzahlZeichen As Integer, bolLinks As Boolean
Dim lngZeile1 As Long, lngZeileE As Long, lngZ As Long
Dim lngZeile As Long, intFF As Integer, strText As String
Dim lngSpalte As Long, intI As Long, arrBreite() As Long
Const strSep = " | " 'Trennzeichen zwischen Daten-Spalten in Tabellenabschnitten
Const strSep2 = " " 'Trennzeichen zwischen Daten-Spalten außerhalb Tabellenabschnitten
On Error GoTo Fehler
varDatei = Application.GetSaveAsFilename(InitialFileName:="TestExport.txt", _
Filefilter:="Text(*.txt), *.txt", _
Title:="Bitte Namen für Export-Datei wählen oder eingeben und speichern")
If varDatei  False Then
Set wks = ActiveSheet
With wks
intFF = FreeFile()
Open varDatei For Output As #intFF
lngZeilelast = .UsedRange.Row + .UsedRange.Rows.Count - 1
For lngZeile = 1 To lngZeilelast
lngZeile1 = lngZeile
'nächste Tabelle suchen ("case id" steht in Spalte A)
Do
lngZeile = lngZeile + 1
If lngZeile > lngZeilelast Then Exit Do                               '###
Loop Until InStr(1, .Cells(lngZeile, 1).Value, "case id") > 0
lngZeileE = lngZeile - 1
'Nicht Tabellentexte in Datei schreiben
Do
strText = wks.Cells(lngZeile1, 1).Text
'ggf. Texte aus weiteren Spalten einlesen
If .Cells(lngZeile1, .Columns.Count).End(xlToLeft).Column > 1 Then
For lngSpalte = 2 To .Cells(lngZeile1, .Columns.Count).End(xlToLeft).Column
intAnzahlZeichen = Len(wks.Cells(lngZeile1, lngSpalte).Text)
strText = strText & strSep2 _
& LeerzeichenAuffuellen(strText:=wks.Cells(lngZeile1, _
lngSpalte).Text, intZeichen:=intAnzahlZeichen, bolLinks:=True)
Next
End If
Print #intFF, strText
lngZeile1 = lngZeile1 + 1
Loop Until lngZeile1 > lngZeileE
If lngZeileE = lngZeilelast Then Exit For                               '####
'Anfang Tabelle setzen
lngZeile1 = lngZeileE + 1
'Ende Tabelle suchen (nächste leere Zeile)
lngZeileE = lngZeile1 + 1
Do
lngZeile = lngZeile + 1
If lngZeile >= lngZeilelast Then Exit Do
Loop Until IsEmpty(.Cells(lngZeile, 1)) Or IsEmpty(.Cells(lngZeile, 2))
lngZeileE = lngZeile - 1
'Letzte Spalte in Titelzeile ermitteln
lngSpalteMax = .Cells(lngZeile1, .Columns.Count).End(xlToLeft).Column
ReDim arrBreite(1 To lngSpalteMax)
'Spalten Breiten ermitteln und in Array speichern
For lngSpalte = 1 To lngSpalteMax
For lngZ = lngZeile1 To lngZeileE
If LCase(.Cells(lngZ, lngSpalte).Text) = "remarks/comment" Then
arrBreite(lngSpalte) = 999
Exit For
Else
If Len(.Cells(lngZ, lngSpalte).Text) > arrBreite(lngSpalte) Then
arrBreite(lngSpalte) = Len(.Cells(lngZ, lngSpalte).Text)
End If
End If
Next
Next
'Zeilen des Tabellenbereichs einlesen
For lngZ = lngZeile1 To lngZeileE
'Wert aus 1. Spalte einlesen
intAnzahlZeichen = arrBreite(1)
strText = LeerzeichenAuffuellen(strText:=.Cells(lngZ, 1).Text, _
intZeichen:=intAnzahlZeichen, bolLinks:=IsNumeric(.Cells(lngZ, 1).Text))
'Werte aus restlichen Spalten einlesen
For lngSpalte = 2 To lngSpalteMax
If arrBreite(lngSpalte)  999 Then
intAnzahlZeichen = arrBreite(lngSpalte)
Else
intAnzahlZeichen = Len(wks.Cells(lngZ, lngSpalte).Text)
End If
bolLinks = IsNumeric(.Cells(lngZeile, 1).Text)
strText = strText & strSep & LeerzeichenAuffuellen(strText:=wks.Cells(lngZ, _
lngSpalte).Text, intZeichen:=intAnzahlZeichen, bolLinks:=bolLinks)
Next
'Zeile in Text-Datei schreiben
Print #intFF, strText
If lngZ = lngZeile1 Then
'Zeile mit "-" nach 1. Zeile der Tabelle einfügen
'Gesamt-Anzahl Zeichen in den Spalten ermitteln
intI = 0
intI = arrBreite(1)
For lngSpalte = 2 To lngSpalteMax
If arrBreite(lngSpalte) = 999 Then
intI = intI + Len(strSep) + Len("remarks/comment")
Else
intI = intI + Len(strSep) + arrBreite(lngSpalte)
End If
Next
strText = String(intI, "-")
Print #intFF, strText
End If
Next
lngZeile = lngZeileE
Next
Close #intFF
End With
End If
Fehler:
If Err.Number  0 Then
Select Case Err.Number
Case 999 '
Case Else
MsgBox "Fehler: " & Err.Number & vbLf & Err.Description
End Select
End If
End Sub


AW: neue Bsp. Datei erstellt ...
Eddie
jetzt schmeist er mir einen Fehler:
Mehrdeutiger Name: LeerzeichenAuffuellen
gruß Eddie
Uppppsss :-)
Eddie
Muss natürlich die Funktion auch mit aufrufen -)
gruß und Danke
Eddie
P.S. Im Danke Franz thread wäre da noch so nen mini wunsch *gg*
noch eine kleine Erweiterung Möglich ?
Eddie
Guten Morgen Franz...
habe noch etwas gefunden :-)
Ich würde gerne, das einmal nach der case id Spalte und vor der Spalte mit den Ausgängen (_A ,_B ... also mit einen Unterstrich) nicht nur ein Trennzeichen '|' ist, sondern 2 Trennzeichen ..
könntest du das vielleicht noch in der Standard Version (nicht die mini-abgespeckte :-) )mit einbauen ?
Danke und Gruß
der Eddie
AW: noch eine kleine Erweiterung Möglich ?
fcs
Hallo Eddie,
hier die modifizierte Hauptprozedur, die bei bestimmten Spalten einen 2. Trennstrich einfügt.
Gruß
Franz

Sub Text_Export()
Dim varDatei, wks As Worksheet, intAnzahlZeichen As Integer, bolLinks As Boolean
Dim lngZeile1 As Long, lngZeileE As Long, lngZ As Long
Dim lngZeile As Long, intFF As Integer, strText As String
Dim lngSpalte As Long, intI As Long, arrBreite() As Long, lngSpalte_mit_A As Long
Const strSep = " | " 'Trennzeichen zwischen Daten-Spalten in Tabellenabschnitten
Const strSep1 = " || " 'Trennzeichen nach Case ID und vor "_A"
Const strSep2 = " " 'Trennzeichen zwischen Daten-Spalten außerhalb Tabellenabschnitten
On Error GoTo Fehler
varDatei = Application.GetSaveAsFilename(InitialFileName:="TestExport.txt", _
Filefilter:="Text(*.txt), *.txt", _
Title:="Bitte Namen für Export-Datei wählen oder eingeben und speichern")
If varDatei  False Then
Set wks = ActiveSheet
With wks
intFF = FreeFile()
Open varDatei For Output As #intFF
lngZeileLast = .UsedRange.Row + .UsedRange.Rows.Count - 1
For lngZeile = 1 To lngZeileLast
lngZeile1 = lngZeile
'nächste Tabelle suchen ("case id" steht in Spalte A)
Do
lngZeile = lngZeile + 1
If lngZeile > lngZeileLast Then Exit Do
Loop Until InStr(1, .Cells(lngZeile, 1).Value, "case id") > 0
lngZeileE = lngZeile - 1
'Nicht Tabellentexte in Datei schreiben
Do
strText = wks.Cells(lngZeile1, 1).Text
'ggf. Texte aus weiteren Spalten einlesen
If .Cells(lngZeile1, .Columns.Count).End(xlToLeft).Column > 1 Then
For lngSpalte = 2 To .Cells(lngZeile1, .Columns.Count).End(xlToLeft).Column
intAnzahlZeichen = Len(wks.Cells(lngZeile1, lngSpalte).Text)
strText = strText & strSep2 _
& LeerzeichenAuffuellen(strText:=wks.Cells(lngZeile1, _
lngSpalte).Text, intZeichen:=intAnzahlZeichen, bolLinks:=True)
Next
End If
Print #intFF, strText
lngZeile1 = lngZeile1 + 1
Loop Until lngZeile1 > lngZeileE
If lngZeileE = lngZeileLast Then Exit For
'Anfang Tabelle setzen
lngZeile1 = lngZeileE + 1
'Ende Tabelle suchen (nächste leere Zeile)
lngZeileE = lngZeile1 + 1
Do
lngZeile = lngZeile + 1
If lngZeile >= lngZeileLast Then Exit Do
Loop Until IsEmpty(.Cells(lngZeile, 1)) Or IsEmpty(.Cells(lngZeile, 2))
lngZeileE = lngZeile - 1
'Letzte Spalte in Titelzeile ermitteln
lngSpalteMax = .Cells(lngZeile1, .Columns.Count).End(xlToLeft).Column
ReDim arrBreite(1 To lngSpalteMax)
'Spalten Breiten ermitteln und in Array speichern
For lngSpalte = 1 To lngSpalteMax
For lngZ = lngZeile1 To lngZeileE
If LCase(.Cells(lngZ, lngSpalte).Text) = "remarks/comment" Then
arrBreite(lngSpalte) = 999
Exit For
Else
If Len(.Cells(lngZ, lngSpalte).Text) > arrBreite(lngSpalte) Then
arrBreite(lngSpalte) = Len(.Cells(lngZ, lngSpalte).Text)
End If
End If
Next
Next
'Spalte mit Titel mit "_A" ermitteln
lngSpalte_mit_A = 999
For lngSpalte = 1 To lngSpalteMax
If InStr(.Cells(lngZeile1, lngSpalte).Text, "_A") > 0 Then
lngSpalte_mit_A = lngSpalte
Exit For
End If
Next
'Zeilen des Tabellenbereichs einlesen
For lngZ = lngZeile1 To lngZeileE
'Wert aus 1. Spalte einlesen
intAnzahlZeichen = arrBreite(1)
strText = LeerzeichenAuffuellen(strText:=.Cells(lngZ, 1).Text, _
intZeichen:=intAnzahlZeichen, bolLinks:=IsNumeric(.Cells(lngZ, 1).Text))
'Werte aus restlichen Spalten einlesen
For lngSpalte = 2 To lngSpalteMax
If arrBreite(lngSpalte)  999 Then
intAnzahlZeichen = arrBreite(lngSpalte)
Else
intAnzahlZeichen = Len(wks.Cells(lngZ, lngSpalte).Text)
End If
bolLinks = IsNumeric(.Cells(lngZeile, 1).Text)
Select Case lngSpalte
Case 2, lngSpalte_mit_A
'Trennzeichen = " || "
strText = strText & strSep1 _
& LeerzeichenAuffuellen(strText:=wks.Cells(lngZ, _
lngSpalte).Text, intZeichen:=intAnzahlZeichen, bolLinks:=bolLinks)
Case Else
'Trennzeichen = " | "
strText = strText & strSep _
& LeerzeichenAuffuellen(strText:=wks.Cells(lngZ, _
lngSpalte).Text, intZeichen:=intAnzahlZeichen, bolLinks:=bolLinks)
End Select
Next
'Zeile in Text-Datei schreiben
Print #intFF, strText
If lngZ = lngZeile1 Then
'Zeile mit "-" nach 1. Zeile der Tabelle einfügen
'Gesamt-Anzahl Zeichen in den Spalten ermitteln
intI = 0
intI = arrBreite(1)
For lngSpalte = 2 To lngSpalteMax
If arrBreite(lngSpalte) = 999 Then
intI = intI + Len(strSep) + Len("remarks/comment")
Else
intI = intI + Len(strSep) + arrBreite(lngSpalte)
End If
Next
'zusätzliche Zeichen für Sonderlänge 1. Trennzeichen und vor "_A" in tabelle
intI = intI + (Len(strSep1) - Len(strSep))
If lngSpalte_mit_A  999 Then
intI = intI + (Len(strSep1) - Len(strSep))
End If
strText = String(intI, "-")
Print #intFF, strText
End If
Next
lngZeile = lngZeileE
Next
Close #intFF
End With
End If
Fehler:
If Err.Number  0 Then
Select Case Err.Number
Case 999 '
Case Else
MsgBox "Fehler: " & Err.Number & vbLf & Err.Description
End Select
End If
End Sub


AW: noch eine kleine Erweiterung Möglich ?
Eddie
Danke Franz .. habe da natürlich auch Dir vergessen zu sagen, das es ja nicht nur A als Anfang gibt, es könnte ja auch_B oder _Z oder _AA als erster Wert sein .. vielleicht kann man das noch etwas modifizieren
danke und gruß Eddie
nochmals Hilfe Nötig :-)
Eddie
Hallo Franz ... kann man die Hilfsversion (mit den steps) und die Hauptversion (case id) vielleicht noch eine Funktion einbauen, wo er erst z.B. ab der 10ten zeile das Makro abarbeiten soll ?
danke und Gruß eddie

316 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige