Sub Teste_Zeilenumbruch()
For n = 1 To Len(Sheets(1).[a1].Text)
MsgBox Asc(Mid(Sheets(1).[a1].Text, n, 1))
Next n
End Sub
Option Explicit
Option Base 0
'Tabellenname der zu bearbeitenden Tabelle
Const TabellenName As String = "Tabelle1"
'Startzeile festlegen
Const StartZeile As Long = 2
Sub Zeilenumbruch_in_Listbox()
Dim mitUmbruch$(), Spalte1&, Spalte2&, letzteZ&, Index&
Dim Bereich As Range
Dim Zelle As Range
Spalte1 = 3 'Spalte C
Spalte2 = 6 'Spalte F
'Letzte Datenzeile der Spalte C ermitteln
letzteZ = letzteZeile(Worksheets(TabellenName), Spalte1)
Set Bereich = Worksheets(TabellenName). _
Range("C" & StartZeile & ":C" & letzteZ)
'Suchvorgang in Spalte C
For Each Zelle In Bereich
If Zelle.Value <> vbNullString Then
If InStr(Zelle.Value, Chr(10)) Then
ReDim Preserve mitUmbruch(Index)
mitUmbruch(Index) = Zelle.Value
Index = Index + 1
End If
End If
Next Zelle
'Letzte Datenzeile der Spalte F ermitteln
letzteZ = letzteZeile(Worksheets(TabellenName), Spalte2)
Set Bereich = Worksheets(TabellenName). _
Range("F" & StartZeile & ":F" & letzteZ)
'Suchvorgang in Spalte F
For Each Zelle In Bereich
If Zelle.Value <> vbNullString Then
If InStr(Zelle.Value, Chr(10)) Then
ReDim Preserve mitUmbruch(Index)
mitUmbruch(Index) = Zelle.Value
Index = Index + 1
End If
End If
Next Zelle
'In die Listbox1 eintragen
With Worksheets(TabellenName)
.ListBox1.List() = mitUmbruch
End With
End Sub
Public Function letzteZeile(vWS As Variant, Optional x As Long = 1) As Long
Dim y As Long
Dim ws As Worksheet
On Error GoTo PROC_ERR
Select Case UCase(TypeName(vWS))
Case "STRING"
Set ws = Worksheets(vWS)
Case "WORKSHEET"
Set ws = vWS
Case Else
GoTo PROC_ERR
End Select
With ws
y = .Rows.Count
letzteZeile = .Cells(y, x).End(xlUp).Row
End With
PROC_EXIT:
Exit Function
PROC_ERR:
letzteZeile = -1
Resume PROC_EXIT
End Function
'In die Listbox1 eintragen
ListBox1.Clear
For Index = 0 To UBound(mitUmbruch)
Worksheets(TabellenName).ListBox1.AddItem mitUmbruch(Index)
Next Index