XL 2019 Optimisation de code VBA

mmaiga

XLDnaute Nouveau
Bonjour,

Je viens vers vous pour pouvoir m'aider concernant l'optimisation de ce code. le code fonctionne mais le temps de l'execution n'est pas à mon goût ( 61 secondes).
Pouvez-vous m'aider à améliorer ce code ?

Je vous joins le fichier Excel. et j'aimerais que les données de la colonne E soient affichées.
Etant donné que le fichier est lourd, j'ai supprimé des données.

Code

Option Explicit

Sub Calculer_test()

' Tranfert pour TEST
Sheets("Feuil1").Range("A1:F13842") = Sheets("Feuil2").Range("A1:F13842").Value
' --------------------------------------------

' Options de calcul

Dim CalcMode As Long
CalcMode = Application.Calculation
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.DisplayStatusBar = False

'---------------------------------------------------

Dim T0: T0 = Timer
Dim lastRow As Long, lat1 As Double, lat2 As Double, lon1 As Double, lon2 As Double, R As Double
Dim dLat As Double, dLon As Double, a As Double, c As Double, d As Double, i As Long, j As Long, k As Long, doublon As Boolean
Dim tablo, T, Cte ' Tableaux de transfert, T étant le résultat
R = 6371 ' Rayon de la terre en km
Cte = Application.Pi / 180 ' PI/180, constante calculée une seule fois au début
lastRow = Range("B" & Rows.Count).End(xlUp).Row
[E:E].ClearContents
tablo = Range("A1:E" & lastRow)
ReDim T(1 To UBound(tablo)): T(1) = "Doublons"
For i = 2 To UBound(tablo)
'Application.StatusBar = "Ligne traitée : " & i & " sur " & lastRow ' A valider si on veut le suivi dans le statusbar
lat1 = tablo(i, 2) * Cte 'conversion de degrés à radians
lon1 = tablo(i, 3) * Cte
doublon = False 'initialisation du drapeau de doublon
For j = i + 1 To UBound(tablo)
If i <> j Then 'ne compare pas avec soi-même
lat2 = tablo(j, 2) * Cte
lon2 = tablo(j, 3) * Cte
dLat = lat2 - lat1
dLon = lon2 - lon1
If Abs(lat1 - lat2) / Cte < 0.1 Or Abs(lon1 - lon2) / Cte < 0.1 Then
a = Sin(dLat / 2) * Sin(dLat / 2) + Cos(lat1) * Cos(lat2) * Sin(dLon / 2) * Sin(dLon / 2)
d = 2 * R * Application.Asin(Sqr(a))
If d < 10 And tablo(i, 4) = tablo(j, 4) And tablo(i, 5) = tablo(j, 5) Then 'enregistre si la distance est inférieure à 10 km et s'il y a un doublon dans la colonne D
'T(i) = T(i) & " " & tablo(j, 1)
T(i) = T(i) & " " & tablo(j, 1) & "(" & j & ": " & Format(d, "0.00") & " km)"
doublon = True 'marque le drapeau de doublon
End If
End If
End If
Next j
If Not doublon Then T(i) = "Aucun doublon trouvé" 'si aucun doublon n'est trouvé, enregistre "Aucun doublon trouvé"
Next i
[F1].Resize(UBound(T), 1).Value = Application.Transpose(T)
Application.StatusBar = ""


'---------------------------------

Application.Calculation = CalcMode
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayStatusBar = True


[K2] = Timer - T0
End Sub





Merci d'avance..
 

Pièces jointes

  • Classeur3.xlsm
    968.9 KB · Affichages: 19

sylvanu

XLDnaute Barbatruc
Supporter XLD
@vgendron
Déjà qu'il ne lit pas ce qu'on écrit, ce n'est pas pour répondre aux questions. 🤣
Vous avez une liste de points définis par leur latitude et longitude.
Est déclaré "Doublon" un point qui se trouve à moins de 10km d'un, ou d'autres points.
Mais uniquement en descendant comme le dit Fanch.

@mmaiga
mais j'aimerais juste améliorer la performance
Vous vouliez dire " j'aimerais juste que vous amélioriez la performance" ?
En PJ, un peu mieux en calculant une seule fois latitude et longitude en degrés, ce qui évite pas mal de calculs ensuite.
Et en supprimant le "If i <> j Then" comme déjà dit puisque j=i+1.
Les résultat sur mon PC :
1681485036591.png
 

Pièces jointes

  • Classeur3 (3).xlsm
    688.8 KB · Affichages: 4

mmaiga

XLDnaute Nouveau
Moi aussi... On perd notre temps pour rien. On aurait dû aider d'autres demandeurs.
@vgendron
Déjà qu'il ne lit pas ce qu'on écrit, ce n'est pas pour répondre aux questions. 🤣
Vous avez une liste de points définis par leur latitude et longitude.
Est déclaré "Doublon" un point qui se trouve à moins de 10km d'un, ou d'autres points.
Mais uniquement en descendant comme le dit Fanch.

@mmaiga

Vous vouliez dire " j'aimerais juste que vous amélioriez la performance" ?
En PJ, un peu mieux en calculant une seule fois latitude et longitude en degrés, ce qui évite pas mal de calculs ensuite.
Et en supprimant le "If i <> j Then" comme déjà dit puisque j=i+1.
Les résultat sur mon PC :
Regarde la pièce jointe 1168264
Merci ça me va. Merci également à vos efforts, désolé pour les personnes qui n'ont pas compris le concept, c'était pas dans mon intention de perdre votre temps.

Je m'excuse...
 

Discussions similaires

Statistiques des forums

Discussions
315 089
Messages
2 116 098
Membres
112 661
dernier inscrit
ceucri