Option Explicit
Sub Kalender()
Dim Überschrift As Boolean, Datei As Variant, Terminzeile As String
Dim Tag As String, Zeit As String, Termin As String
Dim BegZeit As Long, BegTermin As Long, spa As Long, zei As Long, sh As Worksheet, cl As Range
BegZeit = 8
BegTermin = 17
Überschrift = False
Datei = Application.GetOpenFilename("Text Files (*.txt), *.txt")
If Datei = False Then End
Set sh = Sheets.Add
sh.Range("B1:H1") = Array("Mo", "Di", "Mi", "Do", "Fr", "Sa", "So")
Open Datei For Input As #1
zei = 1
Do While Not EOF(1)
Line Input #1, Terminzeile
If Überschrift = False Then
Tag = Left(Terminzeile, 2)
Zeit = Trim(Mid(Terminzeile, BegZeit, 5))
Termin = Trim(Right(Terminzeile, Len(Terminzeile) - BegTermin + 1))
spa = sh.Range("B1:H1").Find(Tag).Column
Set cl = sh.Range("A:A").Find(Zeit)
If cl Is Nothing Then
zei = zei + 1
Cells(zei, 1) = Zeit
Else
zei = cl.Row
End If
If Cells(zei, spa).Value = "" Then Cells(zei, spa).Value = Termin Else Cells(zei, spa).Value = Cells(zei, spa).Value & ", " & Termin
Überschrift = False
End If
Loop
Close #1
sh.UsedRange.Sort Key1:=sh.UsedRange.Range("A:A"), Header:=xlYes
End Sub