Guten Tag,
Ich muss eine ziemlich große Excel Datei für einen Import in SAP vorbereiten. Deshalb möchte ich gerne ein kleines Makro erstellen, welches mir die lässtige Arbeit abnimmt und folgendes tut.
Gehe alle Zeilen des Dokumentes durch:
WENN in einer Zeile Text steht DANN:
Gehe den Text in Blöcken aus 62 Zeichen durch:
Ermittle das letzte Leerzeichen in jedem Block und ersetze es durch einen Zeilenumbruch.
Gut, vielleicht noch mal kurz in normallem Deutsch, worum es allgemein geht. In diesem Excel Dokument gibt es viele Zellen mit Fließtext, nach maximal 62 Zeichen soll es einen Zeilenumbruch geben, dieser soll aber keine Wörter in der Mitte trennen. Deshalb die Regel mit dem „Ermittle das letzte Leerzeichen“. Ich kenne mich in VBA nur sehr dürftig aus und komme einfach nicht mehr weiter. Vielleicht könnte jemand meinen Quelltext verfolgständigen. Mir fällt z.B nicht ein wie ich das gesamte Dokument nach Zeilen und Spalten durchgehen kann und wie ich das Leerzeichen durch den Zeilenumbruch ersetzen kann.
Hoffe jemand kann helfen. Schon mal danke an alle die diesen langen Post gelesen haben
Viele Grüße
Informatics
Hier mein Quelltext:
Dim i As Integer
Dim j As Integer
Dim c As Integer
Dim r As Integer
Dim Buffer As String
c = 1
For i = 1 To 10
For j = 1 To 620 Step 62
Buffer = Mid(Worksheets(„Tabelle1“).Cells(i, 1).Value, j, 62)
While InStr(c, Buffer, " ") > 1
c = InStr(c, Buffer, " ")
Wend
r = c ’ Gebe die Position des letzten Leerzeichens in dem 62 Zeichen Block zurück
c = 1
'Leerzeichen gegen Zeilenumbruch austauschen
Next j
Hallo Informatics,
vielleicht hilft dir die folgende Sub weiter:
Sub UmbruchText()
Const Sollbreite = 62
Dim zz As Range, ii%, pp%
For Each zz In ActiveSheet.UsedRange
pp = 1
Do While pp + Sollbreite 0 And \_
InStr(pp, zz, Chr(10)) Grüße aus Kamp-Lintfort
Erich Gier
Sub Makro1()
Dim myCell As Range
Dim start As Integer
Dim ende As Integer
Dim i As Integer
Dim suche As String
Dim inhalt As String
Dim leerzeichen As Integer
start = 1
ende = 62
For Each myCell In Worksheets("Mappe2").UsedRange
inhalt = myCell.Value
For i = 1 To Int(Len(inhalt) / 62) + 1
suche = Mid(inhalt, start, ende)
leerzeichen = InStrRev(suche, " ")
If leerzeichen 0 Then
myCell.Value = Left(myCell.Value, start - 1) & Left(suche, leerzeichen - 1) & Chr(10) & Mid(suche, leerzeichen + 1) & Mid(myCell.Value, ende)
start = leerzeichen + 1
ende = start + 62
Else
start = start + 63
ende = start + 62
End If
Next
Next
End Sub
Hallo Informatics,
eine kleine Korrektur musste ich in meiner Sub noch anbringen. Sie unterbricht jetzt die Arbeit an einer Zelle, wenn darin ein zu langes Wort vorkommt, also kein Leerzeichen für den Umbruch gefunden wird.
Sub UmbruchText()
Const Sollbreite = 61
Dim zz As Range, ii%, pp%, ppa%
For Each zz In ActiveSheet.UsedRange
pp = 1
Do While pp + Sollbreite 0 And \_
InStr(pp, zz, Chr(10)) Grüße aus Kamp-Lintfort
Erich Gier
Hallo Informatics,
ich habe die Lösung noch etwas ausgebaut. Jetzt kann man (per Inputbox) die max. Zeichenzahl pro Zeile eingeben und auch ale Umbrüche wieder beseitigen.
Bisher haben wir zu lange Zeilen innerhalb der jeweiligen Zelle umgebrochen. Eine andere Möglichkeit, die auch praktisch sein kann, besteht darin, für die Fortsetzungstexte neue Excelzeilen zu erzeugen.
