XL 2019 Optimisation de code VBA

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

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

@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

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...
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
11
Affichages
925
Réponses
3
Affichages
602
Réponses
3
Affichages
525
Retour