Option Explicit
Sub test()
Dim strBESTNR As String
Dim strANZAHL As String
Dim arrZUSFSG() As Variant
Dim lngLaufZahl As Long
Dim SemColPos As Long
lngLaufZahl = 0
With ThisWorkbook.Sheets(1)
strBESTNR = .Range("$B$1")
Do
If strBESTNR = "" Then Exit Do
SemColPos = InStr(1, strBESTNR, ";", vbBinaryCompare)
If SemColPos <> 0 Then
strBESTNR = Right(strBESTNR, Len(strBESTNR) - SemColPos)
Else
strBESTNR = ""
End If
lngLaufZahl = lngLaufZahl + 1
Loop
strBESTNR = .Range("$B$1")
strANZAHL = .Range("$A$1")
ReDim arrZUSFSG(lngLaufZahl, 2)
lngLaufZahl = 0
Do
If strBESTNR = "" Then Exit Do
SemColPos = InStr(1, strBESTNR, ";", vbBinaryCompare)
If SemColPos <> 0 Then
arrZUSFSG(lngLaufZahl, 0) = Left(strBESTNR, SemColPos - 1)
strBESTNR = Right(strBESTNR, Len(strBESTNR) - SemColPos)
Else
arrZUSFSG(lngLaufZahl, 0) = strBESTNR
strBESTNR = ""
End If
SemColPos = InStr(1, strANZAHL, ";", vbBinaryCompare)
If SemColPos <> 0 Then
arrZUSFSG(lngLaufZahl, 1) = CLng(Left(strANZAHL, SemColPos - 1))
strANZAHL = Right(strANZAHL, Len(strANZAHL) - SemColPos)
Else
arrZUSFSG(lngLaufZahl, 1) = CLng(strANZAHL)
strANZAHL = ""
End If
lngLaufZahl = lngLaufZahl + 1
Loop
End With
UserForm1.ListBox1.List() = arrZUSFSG
UserForm1.Show
Unload UserForm1
End Sub