Excel: Überschneidungen von Zeiträumen quantitativ erfassen

Option Explicit

Sub Suchen1()

    Dim index1 As Integer
    Dim index2 As Integer
    Dim Start1 As Double
    Dim Start2 As Double
    Dim Ende1 As Double
    Dim Ende2 As Double
    
    Dim Anzahl As Integer
    Dim Info As String
    
    'Prüfe alle Zeile wo in der 1. Spalte ein Text steht  
    'Starte in Zeile 2  
    index1 = 2
    While (Cells(index1, 1) <> "")  
    
        'Hole Start und Ende Datum mit Uhrzeit  
        Start1 = Cells(index1, 5)
        Ende1 = Cells(index1, 6)
        Anzahl = 0
        Info = ""  
        
        index2 = 2
        'Prüfe alle Zeile wo in der 1. Spalte ein Text steht  
        'Starte in Zeile 2  
        While (Cells(index2, 1) <> "")  
        
            'Die Zeile in der wir gerade stehen ignorieren  
            If (index2 <> index1) Then
            
                'Hole Start und Ende Datum mit Uhrzeit  
                Start2 = Cells(index2, 5)
                Ende2 = Cells(index2, 6)
                
                'Prüfe ob die Anfangs oder Endzeit innerhalb dieser Zeit liegt = Überschneidung  
                If (((Start1 >= Start2) And (Start1 <= Ende2)) Or ((Ende1 >= Start2) And (Ende1 <= Ende2))) Then
                
                    'Erhöhre den Zähler um 1  
                    Anzahl = Anzahl + 1
                    
                    'Schreibe die Zeile in einen String als Information  
                    Info = Info + CStr(index2) + " "  
                    
                End If
                
            End If
            
            'Nächste Zeile  
            index2 = index2 + 1
        Wend
    
        'Schreibe die Ergebnisse in die Tabelle  
        Cells(index1, 8) = Anzahl
        Cells(index1, 9) = Trim(Info)
    
        'Nächste Zeile  
        index1 = index1 + 1
    Wend

    MsgBox ("Fertig")  


End Sub