Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1212to1216
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
Inhaltsverzeichnis

Text aus Zelle teilen und zeilenweise in Textdatei

Text aus Zelle teilen und zeilenweise in Textdatei
Bernd
Hallo,
ich möchte mit VBA unterschiedlich lange Texte aus Spalte A einer Excel-Tabelle aufteilen in Stücke mit maximal 40 Zeichen (der Text soll aber nicht mitten im Wort durchgeschnitten werden) und diese dann zeilenweise in eine Textdatei ausgeben.
Beispiel:
Ausgangstabelle:
Spalte A
Zeile 1: Natürliches Mineralwasser mit Kohlensäure versetzt aus der König-Ludwig-Quelle in Entenhausen.
Zeile 2: Die Haftflächen müssen sauber, trocken, staub- und fettfrei sein.
Zeile 3: Kann als Ein- und Zweistranginstallation verwendet werden.
Textdatei (so soll das Ergebnis in der Textdatei aussehen). An der ersten Ziffer erkennt man, dass die Texte zusammengehören. Die zweite Ziffer gibt die Reihenfolge an:
1;1;Natürliches Mineralwasser mit
1;2;Kohlensäure versetzt aus
1;3;der König-Ludwig-Quelle in Entenhausen.
2;1;Die Haftflächen müssen sauber, trocken,
2;2;staub- und fettfrei sein.
3;1;Kann als Ein- und Zweistranginstallation
3;2;verwendet werden.
Viele Grüße
Bernd
AW: Text aus Zelle teilen und zeilenweise in Textdatei
05.05.2011 18:33:40
Tino
Hallo,
kannst mal testen.
Die Text- Datei wird im Ordner der Excel- Datei erstellt.
Sub Text_()
Dim ArrayQ, ArrayA()
Dim n&, nn&, nnn&, nIndex&, nZ&, sText$
Dim strPfad$

'Quelle 
With Tabelle1
    ArrayQ = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
End With

For n = 1 To Ubound(ArrayQ)
    nn = 1: nZ = 0
    sText = Mid$(ArrayQ(n, 1), 1, 41)
    Do While sText <> ""
        
        If Len(sText) > 40 Then
            nnn = InStrRev(sText, " ")
            If nnn = 0 Then nnn = Len(sText)
        Else
            nnn = 40
        End If
            sText = Trim$(Mid(sText, 1, nnn))
            nn = nn + nnn
        
        
        If sText <> "" Then
            nZ = nZ + 1
            Redim Preserve ArrayA(nIndex)
            ArrayA(nIndex) = n & ";" & nZ & ";" & sText
            nIndex = nIndex + 1
        End If
        sText = Mid$(ArrayQ(n, 1), nn, nn + 41)
    Loop
Next n

strPfad = IIf(Right$(ThisWorkbook.Path, 1) = "\", ThisWorkbook.Path, ThisWorkbook.Path & "\")
strPfad = strPfad & "MeineTextdatei.txt"

Schreibe_TextFile strPfad, Join(ArrayA, vbCrLf)
End Sub

Sub Schreibe_TextFile(sFilename$, sInhalt$)
Dim F%
  
F = FreeFile
Open sFilename For Output As #F
Print #F, sInhalt
Close #F

End Sub
Gruß Tino
Anzeige
AW: Text aus Zelle teilen und zeilenweise in Textdatei
06.05.2011 08:56:14
Bernd
Hallo Tino,
vielen Dank! Das ist genau das, was ich brauchte. Wenn ich das Programm laufen lasse, enthält bei mir die zweite Textzeile allerdings noch 51 Zeichen.
Ergebnis nach Ausführung Deines Codes:
1;1;Natürliches Mineralwasser mit
1;2;Kohlensäure versetzt aus der König-Ludwig-Quelle in
1;3;Entenhausen.
2;1;Die Haftflächen müssen sauber, trocken,
2;2;staub- und fettfrei sein.
3;1;Kann als Ein- und Zweistranginstallation
3;2;verwendet werden.
Viele Grüße
Bernd
AW: Text aus Zelle teilen und zeilenweise in Textdatei
06.05.2011 16:49:26
Tino
Hallo,
hat sich wohl doch ein Fehler eingeschlichen.
Versuch es noch einmal.
Sub Text_()
Dim ArrayQ, ArrayA()
Dim n&, nn&, nnn&, nIndex&, nZ&, sText$
Dim strPfad$

'Quelle 
With Tabelle1
    ArrayQ = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
End With

For n = 1 To Ubound(ArrayQ)
    nn = 1: nZ = 0
    sText = Mid$(ArrayQ(n, 1), 1, 41)
    Do While sText <> ""
        
        If Len(sText) > 40 Then
            nnn = InStrRev(sText, " ")
            If nnn = 0 Then nnn = Len(sText)
        Else
            nnn = 40
        End If
            sText = Trim$(Mid(sText, 1, nnn))
            nn = nn + nnn
        
        
        If sText <> "" Then
            nZ = nZ + 1
            Redim Preserve ArrayA(nIndex)
            ArrayA(nIndex) = n & ";" & nZ & ";" & sText
            nIndex = nIndex + 1
        End If
    Loop
Next n

strPfad = IIf(Right$(ThisWorkbook.Path, 1) = "\", ThisWorkbook.Path, ThisWorkbook.Path & "\")
strPfad = strPfad & "MeineTextdatei.txt"

Schreibe_TextFile strPfad, Join(ArrayA, vbCrLf)
End Sub

Sub Schreibe_TextFile(sFilename$, sInhalt$)
Dim F%
  
F = FreeFile
Open sFilename For Output As #F
Print #F, sInhalt
Close #F

End Sub
Gruß Tino
Anzeige
AW: Text aus Zelle teilen und zeilenweise in Textdatei
09.05.2011 14:34:31
Bernd
Hallo Tino,
mit diesem Code scheint sich das Programm aufzuhängen (Endlosschleife?). Es wird nur die Eieruhr angezeigt, sonst passiert aber nichts weiter.
Viele Grüße
Bernd
AW: Text aus Zelle teilen und zeilenweise in Textdatei
10.05.2011 09:10:38
Tino
Hallo,
da fehlt eine Zeile, wo ist die hingekommen? Sachen gibt es!
Sub Text_()
Dim ArrayQ, ArrayA()
Dim n&, nn&, nnn&, nIndex&, nZ&, sText$
Dim strPfad$

'Quelle 
With Tabelle1
    ArrayQ = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
End With

For n = 1 To Ubound(ArrayQ)
    nn = 1: nZ = 0
    sText = Mid$(ArrayQ(n, 1), 1, 41)
    Do While sText <> ""
        
        If Len(sText) > 40 Then
            nnn = InStrRev(sText, " ")
            If nnn = 0 Then nnn = Len(sText)
        Else
            nnn = 40
        End If
            sText = Trim$(Mid(sText, 1, nnn))
            nn = nn + nnn
        
        
        If sText <> "" Then
            nZ = nZ + 1
            Redim Preserve ArrayA(nIndex)
            ArrayA(nIndex) = n & ";" & nZ & ";" & sText
            nIndex = nIndex + 1
        End If
        sText = Mid$(ArrayQ(n, 1), nn, 41)
    Loop
Next n

strPfad = IIf(Right$(ThisWorkbook.Path, 1) = "\", ThisWorkbook.Path, ThisWorkbook.Path & "\")
strPfad = strPfad & "MeineTextdatei.txt"

Schreibe_TextFile strPfad, Join(ArrayA, vbCrLf)
End Sub

Sub Schreibe_TextFile(sFilename$, sInhalt$)
Dim F%
  
F = FreeFile
Open sFilename For Output As #F
Print #F, sInhalt
Close #F

End Sub
Gruß Tino
Anzeige
AW: Text aus Zelle teilen und zeilenweise in Textdatei
10.05.2011 16:07:11
Bernd
Hallo Tino,
jetzt läuft alles prima!!!
Vielen Dank!!!
Bernd

398 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige