Nach max. 70 Zeichen neue Zeile

Forumthread: Nach max. 70 Zeichen neue Zeile

21.02.2017 15:59:06

belafarinrod666

Hallo zusammen,
ich habe hier eine lange Liste (über 400 Zeilen), Spalte A Bestellnummer, Spalte B Text, Überschrift in Zeile 1.
Nun möchte/muss ich den Text in Spalte B in "Häppchen" à maximal 70 Zeichen aufteilen, jedes "Häppchen" soll in seiner eigenen Zeile stehen (also kein forcierter Zeilenumbruch innerhalb der Zelle). Idealerweise sollte die Aufteilung nicht mitten im Wort sein. Die Bestellnummer in Spalte A sollte dann neben der ersten Zeile des zugehörigen Textes stehen.

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Nach max. 70 Zeichen neue Zeile

21.02.2017 16:14:32

Daniel
AW: Nach max. 70 Zeichen neue Zeile

21.02.2017 16:27:17

belafarinrod666
AW: Nach max. 70 Zeichen neue Zeile

21.02.2017 16:58:59

Daniel

AW: Nach max. 70 Zeichen neue Zeile

21.02.2017 16:14:32

Daniel

Hi
schön für dich.
Da hast du dir ja einiges vorgenommen.
Was wären denn deine konkreten Fragen?
Gruß Daniel

AW: Nach max. 70 Zeichen neue Zeile

21.02.2017 16:27:17

belafarinrod666

Mmh, lass mich kurz überlegen, ich bin hier in einem Excel-Forum, und ich habe eine Excel-Problemstellung geschildert... Die Frage lautet daher: was soll ich heute zum Abendessen kochen? ;-)
Spaß, beiseite, ich bin natürlich auf der Suche nach einer Lösung für meine Problemstellung, so dass ich die Zellen nicht per mühevoller Handarbeit aufteilen muss...
VG
belafarinrod666

AW: Nach max. 70 Zeichen neue Zeile

21.02.2017 16:58:59

Daniel

probier mal diesen Code:

Sub test()
Dim arrNr
Dim arrTxt
Dim strNr As String
Dim strTxt As String
Dim z As Long
Dim Pos
Dim txt As String
arrNr = Cells(1, 1).CurrentRegion.Columns(1)
arrTxt = Cells(1, 1).CurrentRegion.Columns(2)
For z = 2 To UBound(arrNr, 1)
strNr = strNr & vbLf & arrNr(z, 1)
txt = arrTxt(z, 1)
Pos = 0
Do
Pos = Pos + 70
If Pos > Len(txt) Then Exit Do
Pos = InStrRev(txt, " ", Pos)
Mid(txt, Pos, 1) = vbLf
strNr = strNr & vbLf
Loop
strTxt = strTxt & vbLf & txt
Next
arrNr = Split(strNr, vbLf)
arrTxt = Split(strTxt, vbLf)
arrNr(0) = Cells(1, 1).Value
arrTxt(0) = Cells(1, 2).Value
Cells(1, 1).Resize(UBound(arrNr) + 1, 1).Value = WorksheetFunction.Transpose(arrNr)
Cells(1, 2).Resize(UBound(arrTxt) + 1, 1).Value = WorksheetFunction.Transpose(arrTxt)
End Sub

Gruß Daniel

Beliebteste Forumthreads (12 Monate)

Forumthread: Nach max. 70 Zeichen neue Zeile

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread