Insertion automatique de « minuit »
Un lecteur me pose la question suivante : il a dans un modèle une séquence d’heures enregistrées par un capteur, sous le format 00:00.
Chaque fois qu’une mesure est inférieure à la mesure précédente, donc dans le cas où on est passé au jour suivant, il a besoin d’insérer une ligne avec la valeur 00:00 pour minuit.
Voici la macro qui résout le problème, sous réserve d’avoir attribué le nom
« Données » à la série d’heures initiale :
Si vous lancez la macro, vous constaterez qu’elle a bien inséré les lignes requises pour obtenir la séquence finale: 22:32 – 00:00 – 02:12 – 22:38 – 00:00 – 22:32 – 00:00 – 05:34 – 06:28 – 17:55 – 00:00 …
Remarque – Telle quelle, cette macro ne marche pas si la cellule précédant le bloc « Données » n’existe pas, c’est-à-dire si le bloc Données débute en ligne 1. Par ailleurs, elle peut insérer une ligne en trop si la cellule précédant le bloc « Données » contient une valeur.
Chaque fois qu’une mesure est inférieure à la mesure précédente, donc dans le cas où on est passé au jour suivant, il a besoin d’insérer une ligne avec la valeur 00:00 pour minuit.
Voici la macro qui résout le problème, sous réserve d’avoir attribué le nom
« Données » à la série d’heures initiale :
Si vous lancez la macro, vous constaterez qu’elle a bien inséré les lignes requises pour obtenir la séquence finale: 22:32 – 00:00 – 02:12 – 22:38 – 00:00 – 22:32 – 00:00 – 05:34 – 06:28 – 17:55 – 00:00 …
Remarque – Telle quelle, cette macro ne marche pas si la cellule précédant le bloc « Données » n’existe pas, c’est-à-dire si le bloc Données débute en ligne 1. Par ailleurs, elle peut insérer une ligne en trop si la cellule précédant le bloc « Données » contient une valeur.
2 Commentaire(s):
Histoire de ne pas être tributaire de l'emplacement des données :
Sub Insertion_Minuit()
Dim rngCellule As Range
For Each rngCellule In Range("Données").Offset(1, 0).Cells
With rngCellule
If (.Value < .Offset(-1, 0).Value) And (.Value <> "") Then
.EntireRow.Insert shift:=xlDown
.Offset(-1, 0).Value = 0
End If
End With
Next rngCellule
End Sub
By Anonyme, sur 8:30 PM
En fait, on peut aussi simplement remplacer :
If Cell < Cell.Offset(-1, 0).Value Then
Cell.EntireRow.Insert Shift:=xlDown
Cell.Offset(-1, 0).Value = 0
End If
par :
If Cell > Cell.Offset(1, 0).Value Then
Cell.Offset(1, 0).EntireRow.Insert Shift:=xlDown
Cell.Offset(1, 0).Value = 0
End If
By Hervé Thiriez, sur 9:15 AM
Enregistrer un commentaire
<< Accueil