automatische Erfassung der spalte a mit anschliessender Splitterung zu spalte a und b
Sub NameTrennen()
Dim strAlles As String, strDaten() As String, Dname As String, VName As String, WM As String
Dim DnameL As Long, Lname As Long, LIndex As Long, Lzeile As Long, CellPos As Long, Larray As Long, Tzeilen As Long
Dim Rdat As Variant
Open "d:\temp\Daten.txt" For Binary As #1
strAlles = Space(LOF(1))
Get #1, , strAlles
Close #1
If Not Right(strAlles, 2) = vbCrLf Then strAlles = strAlles & vbCrLf
strDaten = Split(strAlles, vbCrLf)
Lzeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Rdat = Range("A2:B" & Lzeile)
For CellPos = 1 To Lzeile - 1
Dname = Rdat(CellPos, 1)
LIndex = 1
Lname = Len(Dname)
Larray = UBound(strDaten())
For DnameL = 1 To Lname
For Tzeilen = LIndex To Larray
If InStr(1, UCase(strDaten(Tzeilen)), Mid(UCase(Dname), 1, DnameL)) > 0 Then
Rdat(CellPos, 1) = Mid(strDaten(Tzeilen), InStr(1, UCase(strDaten(Tzeilen)), Mid(UCase(Dname), 1, DnameL)), DnameL)
VName = Mid(strDaten(Tzeilen), InStr(1, UCase(strDaten(Tzeilen)), Mid(UCase(Dname), 1, DnameL)), DnameL)
Rdat(CellPos, 2) = Mid(Dname, Len(VName) + 1, Len(Dname) - Len(VName))
LIndex = Tzeilen
Exit For
End If
Next Tzeilen
Next DnameL
Next CellPos
Range("A2:B" & Lzeile) = Rdat
End Sub