XL 2019 Optimisation code VBA

Bonjour tout le monde,

J'aurai besoin de votre aide pour optimiser ce code car celui-ci est hyper lent et ça prend énormément de temps donc j'ai besoin de votre aide pour ça.

Le but de ce code est de trouver des doublons sur les sites les proches dans un rayon de 10 km. le code marche bien mais le temps de latence n'est pas à mon goût.

Et j'aimerais qu'à la fin s'il détecte les doublons de m'afficher la distance entre sites

Ce code contient plus de 13482 lignes.
Ci-dessous le code:

Sub CalculerDistances()

Dim lastRow As Long
Dim lat1 As Double
Dim lat2 As Double
Dim lon1 As Double
Dim lon2 As Double
Dim R As Double
Dim dLat As Double
Dim dLon As Double
Dim a As Double
Dim c As Double
Dim d As Double
Dim i As Long
Dim j As Long
Dim k As Long
Dim doublon As Boolean

R = 6371 'rayon de la terre en km

lastRow = Range("B" & Rows.Count).End(xlUp).Row

For i = 2 To lastRow
lat1 = Range("B" & i).Value * Application.Pi / 180 'conversion de degrés à radians
lon1 = Range("C" & i).Value * Application.Pi / 180

doublon = False 'initialisation du drapeau de doublon

For j = 2 To lastRow
If i <> j Then 'ne compare pas avec soi-même
lat2 = Range("B" & j).Value * Application.Pi / 180
lon2 = Range("C" & j).Value * Application.Pi / 180

dLat = lat2 - lat1
dLon = lon2 - lon1

a = Sin(dLat / 2) * Sin(dLat / 2) + Cos(lat1) * Cos(lat2) * Sin(dLon / 2) * Sin(dLon / 2)
c = 2 * Application.Asin(Sqr(a))
d = R * c

If d < 10 And Range("D" & i).Value = Range("D" & j).Value Then 'enregistre si la distance est inférieure à 10 km et s'il y a un doublon dans la colonne D
Range("E" & i).Value = Range("E" & i).Value & " " & Range("A" & j).Value
doublon = True 'marque le drapeau de doublon
End If
End If
Next j

If Not doublon Then Range("E" & i).Value = "Aucun doublon trouvé" 'si aucun doublon n'est trouvé, enregistre "Aucun doublon trouvé"
Next i
End Sub