Hallo Stephan,

ich weiß zwar nicht, ob dies best practise ist, aber es erfüllt Deine Anforderungen.

Ich habe jedoch einen weiteren "Result" in der Tabelle angelegt (Dies müsstest Du auch machen).

So bleiben Deine Originaldaten erhalten. Die Ergebnisse werden dann im Reiter "Result" angezeigt. 

Option Explicit

Sub SuchenUndErsetzen()

Dim blSearchDirectionIsAscending As Boolean
Dim blIdIsAvailableAtTime As Boolean
Dim intColumn As Integer
Dim lngRow As Long
Dim lngLastrow As Long
Dim i As Integer
Dim strID As String
Dim strIDAtTime As String
Dim strNewValue As String
Dim wsIndex As Worksheet
Dim wsResult As Worksheet
Dim intMinTime As Integer
Dim intMaxTime As Integer
Dim intStartTime As Integer
Dim intCurrentTime As Integer
Dim nextTime As Integer


Set wsIndex = Sheets("Index")
Set wsResult = Sheets("Result")

'Originaldaten in Reiter Result kopieren
    With wsIndex
        'letzteZeile Ermitteln ermitteln
        lngLastrow = .Cells(Rows.Count, 1).End(xlUp).row
        .Range(.Cells(1, 1), .Cells(lngLastrow, 4)).Copy
    End With
    'ID und Startzeitraum in Reiter StartTime kopieren
    
With wsResult
    .UsedRange.Clear
    .Cells(1, 2).PasteSpecial xlPasteAll


    intMinTime = .Cells(2, 2).Value
    intMaxTime = .Cells(lngLastrow, 2).Value
End With
    'Zeit und ID für Suche per SVerweis verketten und in Spalte A eintragen
    wsResult.Cells(1, 1).Value = "Zeitraum - ID"
    For i = 2 To lngLastrow
        With wsResult
            intStartTime = .Cells(i, 2).Value
            strID = .Cells(i, 3).Value
            strIDAtTime = intStartTime & strID
            .Cells(i, 1).Value = intStartTime & strID
            .Cells(i, 6).Value = strID & .Cells(i, 4)
            .Cells(i, 7).Value = strID & .Cells(i, 5)
        End With
    Next i
    'Durchlauf der Wertespalten
    
    With wsResult
        For intColumn = 4 To 5
        
            For lngRow = 2 To lngLastrow
            
                If .Cells(lngRow, intColumn).Value = "N/A" Then
                intStartTime = .Cells(lngRow, 2).Value
                strID = .Cells(lngRow, 3).Value
                'Prüfung, ob der Befriff ausschließlich "N/A" - Werte ausgibt
                If Application.WorksheetFunction.CountIf(.Range(.Cells(2, 3), .Cells(lngLastrow, 3)), strID) = _
                    Application.WorksheetFunction.CountIf(.Range(.Cells(2, intColumn + 2), .Cells(lngLastrow, intColumn + 2)), .Cells(lngRow, intColumn + 2).Value) Then
                        .Cells(lngRow, intColumn).Value = 0
                        .Cells(lngRow, intColumn).Interior.ColorIndex = 9
                Else
                
                .Cells(lngRow, intColumn).Interior.ColorIndex = 8

                    strIDAtTime = .Cells(lngRow, 1).Value
                    intCurrentTime = .Cells(lngRow, 2)
CheckAgain:
                    'SuchRichtung ermitteln

                    blSearchDirectionIsAscending = searchDirectionIsAscending(intCurrentTime, intMaxTime, intStartTime)
                    'nächsten Zeitraum für Wertsuche ermitteln
                    
                    nextTime = getNewTime(intMinTime, intMaxTime, intStartTime, intCurrentTime, blSearchDirectionIsAscending)
                    If nextTime = -1 Then
                        strNewValue = 0
                        .Cells(lngRow, intColumn).Value = strNewValue
                        .Cells(lngRow, intColumn).Interior.ColorIndex = 6
                        GoTo EndLoop
                    End If
                    'Prüfen, ob id in diesem Zeitraum vorhanden ist
                    strIDAtTime = nextTime & strID
                    blIdIsAvailableAtTime = isIdAvailableAtTime(strIDAtTime)
                    
                    If blIdIsAvailableAtTime = True Then
                    
                        strNewValue = valueOfIdAtTime(strIDAtTime, intColumn)
                        If strNewValue = "N/A" Then
                            intCurrentTime = nextTime
                            GoTo CheckAgain
                        End If
                        
                        .Cells(lngRow, intColumn).Value = strNewValue
                        .Cells(lngRow, intColumn).Interior.ColorIndex = 5
                    Else
                        
                        nextTime = getNewTime(intMinTime, intMaxTime, intStartTime, intCurrentTime, blSearchDirectionIsAscending)
                        intCurrentTime = nextTime
                        GoTo CheckAgain
      
                    End If
                   End If
                End If
EndLoop:
            Next lngRow
            
        Next intColumn
    End With
'Rechenspalten wieder löschen
wsResult.Range("A:A,F:F,G:G").Delete

End Sub

Function isIdAvailableAtTime(strIDAtTime As String) As Boolean
Dim rngVlookup As Range
Dim strResult As String
Dim lngLastrow As Long

With Sheets("Result")
    lngLastrow = .Cells(Rows.Count, 1).End(xlUp).row
    Set rngVlookup = .Range(.Cells(2, 1), .Cells(lngLastrow, 1))
    'Suche, ob die ID zum Zeitpunkt verfügbar ist
    On Error GoTo ErrorHandler
    strResult = Application.WorksheetFunction.VLookup(strIDAtTime, rngVlookup, 1, False)
    isIdAvailableAtTime = True
    Exit Function
End With
ErrorHandler:
    isIdAvailableAtTime = False
End Function

Function valueOfIdAtTime(strIDAtTime As String, intColumn As Integer) As String
Dim rngVlookup As Range
Dim strResult As String
Dim lngLastrow As Long

With Sheets("Result")
    lngLastrow = .Cells(Rows.Count, 1).End(xlUp).row
    Set rngVlookup = .Range(.Cells(2, 1), .Cells(lngLastrow, intColumn))
    'Wert der ID zum Zeitpunkt
    valueOfIdAtTime = Application.VLookup(strIDAtTime, rngVlookup, intColumn, False)
End With
End Function

Function searchDirectionIsAscending(intCurrentTime As Integer, intMaxTime As Integer, startTime As Integer) As Boolean
    If intCurrentTime = intMaxTime Then
        searchDirectionIsAscending = False
    ElseIf intCurrentTime < startTime Then
        searchDirectionIsAscending = False
    Else
        searchDirectionIsAscending = True
    End If
    
End Function

Function getNewTime(minTime As Integer, maxTime As Integer, startTime As Integer, currentTime As Integer, searchDirectionIsAscending As Boolean) As Integer
    Select Case currentTime
        Case Is < maxTime:
            If searchDirectionIsAscending = True Then
                getNewTime = currentTime + 1
            Else
                getNewTime = currentTime - 1
            End If
        Case Is = maxTime:
            getNewTime = startTime - 1
        End Select
End Function

Viele Grüße

Kai