XL 2019 Optimisation code VBA

[mmaiga]

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

 

[sylvanu]

Bonjour Mmaiga,
Utilisez les balises pour le code, c'est moins indigeste. ( à droite de l'icone GIF )
Fournissez un petit fichier test, ce sera plus simple. Sinon il faut se retaper un fichier pour le test.
Pour aller vite, il faut éviter à tout prix de lire écrire dans les cellules.
Donc le plus rapide est de passer la plage dans un array, travailler sur l'array et le restituer à la fin.
Et aussi optimiser les calculs, par ex dans votre programme vous calculer (2*i*2*j) fois Application.Pi / 180
alors qu'en déclarant Cet=Application.Pi / 180 au début vous ne le calculez qu'une seule fois.

 

[mmaiga]

Bonjour Sylvanu,

Merci pour ce retour rapide. Ci-joint le fichier Excel.

J'aimerais qu'à la fin du résultat vous mettez la distance entre les sites détectés.

Dans l'attente de votre retour...

 

[sylvanu]

optimiser ce code car celui-ci est hyper lent

Avec 13842 coordonnées, ça fait 191 millions de boucles ... donc ce sera long quel que soit la méthode employée.

En PJ un essai en passant par des arrays.
Sur mon PC pour 1000 lignes ça mets 12.6s au lieu de 81.8s soit près le 7 fois plus vite.
( En extrapolant pour 13842 lignes cela ferait 2.9 minutes au lieu de 18.8 .... mai je n'ai pas eu le courage de tester sur une telle plage. )
A noter qu'on peut valider la ligne Application.statusbar, on voit ainsi la progression en bas de l'écran, mais comme ça ralentit un tout petit peu le temps je l'ai mis en commentaire pour optimiser.

A noter une variante ( dans module 3 ) c'est de ne comparer que les coordonnées en dessous de la ligne concernée. C'est peut être suffisant. Dans ce cas, dans le même contexte, ça ne met que 6.3s, soit 13 fois plus vite.

 

[mmaiga]

Re,

Merci sylvanu,
Merci pour ce retour.

Le temps de latence a été fortement amélioré actuellement je suis à 459 secondes. Y a t il pas un autre moyen d'améliorer d'avantage.

 

[sylvanu]

Re,
Pas à ma connaissance dans l'état.
Après il faut voir là où on perd du temps, je vais regarder quel point il faudrait travailler.

En partant de la macro CalculerDistances2 et sur 1000 lignes, sur mon PC :
- Dans l'état : 6.21s
- Sans ces deux lignes, 0.23s

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

Evidemment on aurait pu sans douter.

Peut être une piste :
Si l'écart entre deux longitudes ou deux latitudes est > à une certaine valeur, alors de toute façon la distance sera >10km, donc inutile de calculer.
A gratter !

 

[sylvanu]

Re,
En prenant les valeurs brutes des colonnes B et C, si abs(lat1-lat2)>0.1 ou si abs(lon1-lon2)>0.14 alors la distance sera supérieure à 10km, donc inutile de calculer a et d, et on peut sauter tout le paragraphe de calcul.
Je pense que c'est la solution si vous voulez vraiment accélérer le processus.

 

[sylvanu]

Re,
Une nouvelle PJ, à vérifier.
Si l'écart de latitude ou l'écart de longitude est supérieur à 0.1 alors la distance sera supérieure à 10km, donc inutile de faire les calculs.
Et là, à même contexte, je tombe à 0.7s au lieu des 6s précédemment et des 81s de votre fichier pour 1000 lignes.
Sur les 13842 lignes, je mets 128s. Il vous suffit sur la PJ d'appuyer sur le bouton orange.
A bien vérifier.

 

[mmaiga]

Re sylvanu,

Merci infiniment. Franchement bravo pour ce travail. Je suis passé à 54.63 s un gain de temps fou par rapport au temps de latence précédent...

Vous m'avez beaucoup aidé. Je ne sais pas si on peut faire mieux en tout cas ce temps de latence me convient bien...

 

[sylvanu]

Pour les lecteurs futurs, il serait bien de mettre la bonne PJ en résolu, cela leur simplifierait la vie.

 

[bsalv]

si on utilise le phycellid dans le 2ème boucle, au lieu de tout, on gagne du temps (maintenant 9 sec)

 

[mmaiga]

si on utilise le phycellid dans le 2ème boucle, au lieu de tout, on gagne du temps (maintenant 9 sec)

Bonjour bsalv,

Merci pour ce retour. Effectivement, on gagne du temps. Actuellement je suis à 8.55 secondes.

Merci à vous..