Sub FindNearestKoord()
  Dim a, r&(1 To 2), n(1 To 4), i&
  a = Cells(2, 1).Resize(Cells(Rows.Count, 1).End(xlUp).Row - 1, 9)
  For r(1) = 1 To UBound(a)
    For i = 1 To 4:  n(i) = Empty:  Next
    r(2) = 1:  Application.StatusBar = r(1) & " " & UBound(a)
    Do While r(2) <= UBound(a)
      If a(r(1), 1) = a(r(2), 1) And a(r(1), 2) = a(r(2), 2) And r(1) <> r(2) Then
        If a(r(2), 4) > a(r(1), 4) Then
          If IsEmpty(n(1)) Then n(1) = r(2) Else If a(r(2), 4) < a(n(1), 4) Then n(1) = r(2)
        Else
          If IsEmpty(n(2)) Then n(2) = r(2) Else If a(r(2), 4) > a(n(2), 4) Then n(2) = r(2)
        End If
        If a(r(2), 5) > a(r(1), 5) Then
          If IsEmpty(n(3)) Then n(3) = r(2) Else If a(r(2), 5) < a(n(3), 5) Then n(3) = r(2)
        Else
          If IsEmpty(n(4)) Then n(4) = r(2) Else If a(r(2), 5) > a(n(4), 5) Then n(4) = r(2)
        End If
      End If
      r(2) = r(2) + 1
    Loop
    For i = 1 To 4
      If Not IsEmpty(n(i)) Then a(r(1), i + 5) = a(n(i), IIf(i < 3, 4, 5))
    Next
  Next
  Cells(2, 1).Resize(UBound(a), UBound(a, 2)) = a: Application.StatusBar = False
End Sub