Erreur de comparaison entre 2 heures identiques
Bonjour à tous,
Je dispose d'un fichier Excel dont l'architecture est la suivante :
1. A partir du 2e onglet, plusieurs onglets de relevé de mesure de capteurs à la structure identique : Colonne A une date (27 ou 28/02/2023), Colonne B une heure, Colonne D & E & F des données. Le nom des onglets correspond au nom du capteur.
Chaque onglet comporte des dates, heures et valeurs différentes.
2. Un onglet " analyse " dans lequel je souhaite créer un tableau regroupant l'ensemble des données des différents capteurs. Ne sachant pas à l'avance quelles heures sont présentes dans les relevé des capteurs, j'ai repéré l'heure minimale et maximale dans l'ensemble des onglets pour les deux dates et créé une ligne par minute dans ces intervalles.
Le but de ma macro et de remplir ce tableau de synthèse avec les données de chaque capteur, en les positionnant dans la bonne colonne (capteur), et sur la bonne ligne (horaire).
J'ai créé la macro suivante, qui bien que me paraissant lourde (ouvert à toute suggestion d'amélioration ou alternative), marche sur le papier :
Pour chaque capteur :
1. Détecte dans le fichier analyse la zone correspondante
2. Pour chaque ligne de donnée du capteur, compare l'heure et la date avec toutes les lignes du fichier analyse afin de trouver la ligne correspondante.
3. Recopie les données correspondantes
Sub RecupererValeurs()
Dim ws As Worksheet
Dim Analyse As Worksheet
Dim nligneAnalyse As Integer
Dim nligneOnglet As Integer
Dim ncolonne As Integer
Dim lastRow As Long
Dim i As Integer
Dim j As Integer
Dim k As Integer
Set Analyse = ThisWorkbook.Worksheets("Analyse")
' boucle pour parcourir les onglets
For Each ws In ThisWorkbook.Worksheets
If ws.Index > 1 Then
lastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
' boucle pour parcourir la ligne A et trouver la zone associée au nom de capteur
For i = 6 To 150
If Range(LetCol(i) & 1).Value = ws.Name Then
ncolonne = i
' boucle pour parcourir les lignes de chaque onglet
For j = 2 To lastRow
k = 315
' boucle while pour comparer les dates et heure de chaque ligne d'un onglet avec celles de l'onglet analyse, puis si match recopier les données
' de la ligne correspondante
While ws.Range("A" & j).Value <> Analyse.Range("B" & k).Value Or ws.Range("B" & j).Value <> Analyse.Range("C" & k).Value
k = k + 1
Wend
nligneOnglet = j
nligneAnalyse = k
' boucles If pour conserver la valeur la plus élevée si certaines lignes de date et d'heure sont en double
If Analyse.Range(LetCol(ncolonne - 3) & k).Value = "" Or Analyse.Range(LetCol(ncolonne - 3) & k).Value < ws.Range("D" & j).Value Then
Analyse.Range(LetCol(ncolonne - 3) & k).Value = ws.Range("D" & j).Value
End If
If Analyse.Range(LetCol(ncolonne - 1) & k).Value = "" Or Analyse.Range(LetCol(ncolonne - 1) & k).Value < ws.Range("E" & j).Value Then
Analyse.Range(LetCol(ncolonne - 1) & k).Value = ws.Range("E" & j).Value
End If
If Analyse.Range(LetCol(ncolonne + 1) & k).Value = "" Or Analyse.Range(LetCol(ncolonne + 1) & k).Value < ws.Range("F" & j).Value Then
Analyse.Range(LetCol(ncolonne + 1) & k).Value = ws.Range("F" & j).Value
End If
Next j
End If
Next i
End If
Next ws
End SubQuand je la lance, la macro renvoie l'erreur :
Après investigation, l'erreur semble venir de la boucle While qui tourne sans fin à cause de la comparaison de l'heure entre la ligne du capteur et l'onglet " analyse ". En effet, il semble y avoir un problème d'arrondi dans la transcription numérique des dates en VBA bien que les dates en format " hh:mm" soient identiques.
Exemple : les données de la première ligne du capteur 1.1.e (27/02/2023 - 14:50) devraient s'inscrire dans la ligne 316 du fichier analyse (27/02/2023 - 14:50).
Or, pour k = 316 dans mon code, les valeurs des cellules contenant l'heure ne sont pas strictement identiques, ce qui empêche la suite du code de se déclencher.
J'ai essayé de formater les données en format numérique, standard, hh:mm:ss, hh:mm... mais rien n'y fait, les valeurs numériques telles que considérées dans la macro VBA sont toujours fausses à quelques arrondis près.
Une idée de solution ?
Merci d'avance :)
Bonjour,
voici plusieurs idées pour traiter ce genre de soucis:
FormatDateTime: convertit une date fournie sous forme de nombre de texte, ainsi on peut obtenir dans les deux cas "27/02/2023 14:50":
val1 = 44984.6180555556
val2 = 44984.6180555556
Debug.Print FormatDateTime(val1, vbGeneralDate)
Debug.Print FormatDateTime(val2, vbGeneralDate)
Debug.Print FormatDateTime(val1, vbGeneralDate) = FormatDateTime(val2, vbGeneralDate)donne:
DateDiff: fais la différence entre deux dates, on peut spécifier sous quelle forme la différence doit être retournée:
Ici j'utilise les secondes:
val1 = 44984.6180555556
val2 = 44984.6180555556
Debug.Print DateTime.DateDiff("s", val1, val2)qui donne:
On peut tester que l'écart entre les 2 dates est de 0 secondes.
Ou alors utiliser Round:
val1 = 44984.6180555556
val2 = 44984.6180555556
Debug.Print Round(val1, 6) = Round(val2, 6)donne:
Merci, l'astuce du Round a parfaitement fonctionné.
Le code marche alors plutôt bien, a une exception prête : la boucle While se termine alors que les deux conditions ne sont pas remplies.
Exemple :
Paramètres : capteur 1.2.e : i = 6 / ligne 40 : j=4 >> 28/02/2023 à 09:49
Les données de cette ligne devraient alors être inscrites dans la ligne 598 (=k) de l'onglet " analyse ".
Or, pour k = 15, ce qui correspond aux valeur de date et heure 27/02/2023 à 09h49, la boucle While s'arrête et enclenche le reste du code. Pourtant, seule l'une des deux conditions de sortie avait été atteinte (condition heure mais pas date).
J'ai essayé de remplacer le " And " par un " Or ", mais le code ne tourne alors plus car la boucle While ne se termine jamais.
Je pense que le problème vient simplement d'une adaptation des arguments de la boucle While.
> Une idée ? :)
> Merci d'avance
Bonjour,
J'ai fait quelques tests et ce code semble produire le résultat souhaité:
Sub RecupererValeurs()
Dim Ws As Worksheet, Analyse As Worksheet
Dim nligneAnalyse As Integer, nligneOnglet As Integer, ncolonne As Integer, i As Integer, j As Integer, k As Integer
Dim lastRow As Long, ligFinAnalyse As Long
Application.ScreenUpdating = False
Set Analyse = ThisWorkbook.Worksheets("Analyse")
ligFinAnalyse = Analyse.Range("B" & Rows.Count).End(xlUp).Row
' boucle pour parcourir les onglets
For Each Ws In ThisWorkbook.Worksheets
If Ws.Index > 1 Then
lastRow = Ws.Cells(Rows.Count, "A").End(xlUp).Row
' boucle pour parcourir la ligne A et trouver la zone associée au nom de capteur
For i = 6 To 150
If Range(LetCol(i) & 1).Value = Ws.Name Then
ncolonne = i
' boucle pour parcourir les lignes de chaque onglet
For j = 2 To lastRow
nligneOnglet = 0
nligneAnalyse = 0
For k = 3 To ligFinAnalyse
' boucle for pour comparer les dates et heure de chaque ligne d'un onglet avec celles de l'onglet analyse, puis si match recopier les données
' de la ligne correspondante
If CDate(Ws.Range("A" & j).Value) = CDate(Analyse.Range("B" & k).Value) _
And Round(Ws.Range("B" & j).Value, 6) = Round(Analyse.Range("C" & k).Value, 6) Then
nligneOnglet = j
nligneAnalyse = k
Exit For
End If
Next k
If Not nligneOnglet = 0 And Not nligneAnalyse = 0 Then 'si pas de correspondance on passe
' boucles If pour conserver la valeur la plus élevée si certaines lignes de date et d'heure sont en double
If Analyse.Range(LetCol(ncolonne - 3) & k).Value = "" Or Analyse.Range(LetCol(ncolonne - 3) & k).Value < Ws.Range("D" & j).Value Then
Analyse.Range(LetCol(ncolonne - 3) & k).Value = Ws.Range("D" & j).Value
End If
If Analyse.Range(LetCol(ncolonne - 1) & k).Value = "" Or Analyse.Range(LetCol(ncolonne - 1) & k).Value < Ws.Range("E" & j).Value Then
Analyse.Range(LetCol(ncolonne - 1) & k).Value = Ws.Range("E" & j).Value
End If
If Analyse.Range(LetCol(ncolonne + 1) & k).Value = "" Or Analyse.Range(LetCol(ncolonne + 1) & k).Value < Ws.Range("F" & j).Value Then
Analyse.Range(LetCol(ncolonne + 1) & k).Value = Ws.Range("F" & j).Value
End If
End If
Next j
End If
Next i
End If
Next Ws
End SubJ'ai changé la boucle while pour une boucle for en utilisant la ligne de fin de la feuille analyse, et j'ai changé un peu la condition du while qui avait été mise, j'ai aussi convertit les données de dates en dates, car l'une d'entre elle était stockée sous forme de texte (comparaison texte et nombre donne une différence, même si le texte écrit exactement la même chose).
Bonjour,
Merci beaucoup pour le code actualisé qui fonctionne parfaitement !
Pour ma culture VBAesque personnelle, une idée de pourquoi la boucle While ne fonctionnait pas en l'état avec And ou Or ?
Bonne journée et merci encore :)
Premièrement la boucle While Wend ne gère pas le fait qu'on peut ne pas avoir de correspondance de date et d'heure, elle va juste continuer à chercher jusqu'à en trouver une. Je ne la trouve pas adaptée dans ce cas car on sait facilement obtenir le nombre de lignes que l'on a pour chercher.
Ensuite je pense qu'il y avait un problème supplémentaire en plus de celui des arrondis d'heures:
While ws.Range("A" & j).Value <> Analyse.Range("B" & k).ValueIci je me retrouvais avec d'un côté "27/02/2023" qui était comparé à 27/02/2023, un texte comparé à un nombre, donc même dans ce cas là on aurait pas trouvé de correspondance, pour éviter ce genre de problème j'ai forcé VBA à convertir toutes les dates en dates, avec un CDate, histoire d'être sûr qu'on compare la même chose.
J'ai écris un petit code de test pour illustrer ça:
Sub test()
Dim date1, date2
date1 = "27/02/2023"
date2 = CDate("27/02/2023")
MsgBox date1 = date2
End SubSi on regarde de plus près les valeurs au moment de l'exécution de la ligne MsgBox (en mode pas à pas), on voit:
Une date stockée comme texte, une date stockée comme date, et la comparaison renvoie faux, car on a pas la même valeur.