XL 2019 Suppression multiple de lignes - Macro

B

Bastien43

XLDnaute Occasionnel
Bonjour,

J'ai un fichier "releve compteur" : la première colonne contient la date+heure et la deuxième le volume relevé.

Je cherche à conserver uniquement les lignes de relevé qui ont lieu toutes les 15 minutes avec leur volume correspondant. Par exemple :

09/03/2021 00:00:001250000
09/03/2021 00:15:001250010
09/03/2021 00:30:001250011
09/03/2021 00:45:001250050
09/03/2021 01:00:001250055
09/03/2021 01:15:001250070
09/03/2021 01:30:001250090
09/03/2021 01:45:001250092
09/03/2021 02:00:001250100

Je souhaite supprimer les lignes non nécessaires. J'ai plusieurs fichiers de ce type et les relevés compteurs ne sont pas identiques. L'espacement entre les dates peut varier.

La date de relevé peut être aussi sur une journée ou bien s'étendre sur plusieurs jours (1 semaine).

Comment faire une macro ? Des idées svp ? ou bien une solution ? La tâche manuelle est fastidieuse.

Je vous remercie.
Cordialement
Bastien
 

Pièces jointes

  • Releve Compteur.xls
    194 KB · Affichages: 19
Solution
job75
Bastien43 à dit:
Ce que je voulais dire, en copiant de nouvelles données dans la première feuille, cela ne donne pas un résultat fiable à 100% dans la 2e
Cliquez pour agrandir...
C'est fiable à 100%, Excel ne fait pas dans le bricolage.
Bastien43 à dit:
par contre, pas moyen de le faire avec une macro ? sans 2e feuille ? ce serait plus simple.
Cliquez pour agrandir...
On peut bien sûr ne pas utiliser une 2ème feuille et c'est très facile, mais alors les données sources seront perdues, c'est un inconvénient.

Placez cette macro dans un module standard (Module1) :
VB: 
Sub Une_feuille()
Dim tablo, i&, dat$, min%, n&
tablo = [A1].CurrentRegion.Resize(, 2) 'feuille active
For i = 1 To UBound(tablo)
    dat = Format(tablo(i, 1), "mm/dd/yyyy hh:mm") 'date au format US
    min = Val(Right(dat, 2))
    If...
Trier par date Trier par votes
Etoto

Etoto

XLDnaute Barbatruc
Bastien43 à dit:
Bonjour,

J'ai un fichier "releve compteur" : la première colonne contient la date+heure et la deuxième le volume relevé.

Je cherche à conserver uniquement les lignes de relevé qui ont lieu toutes les 15 minutes avec leur volume correspondant. Par exemple :

09/03/2021 00:00:001250000
09/03/2021 00:15:001250010
09/03/2021 00:30:001250011
09/03/2021 00:45:001250050
09/03/2021 01:00:001250055
09/03/2021 01:15:001250070
09/03/2021 01:30:001250090
09/03/2021 01:45:001250092
09/03/2021 02:00:001250100

Je souhaite supprimer les lignes non nécessaires. J'ai plusieurs fichiers de ce type et les relevés compteurs ne sont pas identiques. L'espacement entre les dates peut varier.

La date de relevé peut être aussi sur une journée ou bien s'étendre sur plusieurs jours (1 semaine).

Comment faire une macro ? Des idées svp ? ou bien une solution ? La tâche manuelle est fastidieuse.

Je vous remercie.
Cordialement
Bastien
Cliquez pour agrandir...
Bonjour,

Créer une macro aussi est fastidieux mais tu le fais qu'une fois ;) .
 
Vote positif 0 Vote négatif
S

soan

XLDnaute Barbatruc
Inactif
Bonjour Bastien, Etoto,

* le 1er fichier est un .xls (215 Ko)
* le 2ème fichier est le .xls converti en .xlsm (52 Ko)
➯ gain : -163 Ko (-75,81 %)

à part cette différence de taille, les 2 fichiers sont identiques.


sur la feuille "CPT_LANDE_RAGOT", fais Ctrl e ➯ c'est fait ! 😊

le nombre de lignes est passé de 2 244 à ... 216 ! 🥳

donc y'a eu 2 028 lignes en moins ! 🤩


code VBA de Module1 :

VB: 
Option Explicit: Option Base 1

Sub Essai()
  Dim n&: n = Cells(Rows.Count, 1).End(3).Row: If n = 1 Then Exit Sub
  Dim T1, T2, k As Byte, i&, j&
  n = n - 1: T1 = [A2].Resize(n, 2): ReDim T2(n, 2): j = 1
  Application.ScreenUpdating = 0: Range("A2:B" & n + 1) = Empty
  For i = 1 To n
    k = Minute(T1(i, 1)) Mod 15
    If k = 0 Then
      T2(j, 1) = CDate(T1(i, 1)): T2(j, 2) = T1(i, 2): j = j + 1
    End If
  Next i
  [A2].Resize(n, 2) = T2
End Sub

soan
 

Pièces jointes

  • Releve Compteur v1.xls
    215 KB · Affichages: 3
  • Releve Compteur v1.xlsm
    51.8 KB · Affichages: 4
Dernière édition:
Vote positif 0 Vote négatif
B

Bastien43

XLDnaute Occasionnel
Bonjour,

Merci beaucoup, cela me facilite le travail.

Une question : comment éviter les doublons ou données triples svp ? Est-ce possible d'avoir qu'une seule ligne pour le même quart de temps ?

03/09/2021 08:00 50072
03/09/2021 08:15 50091
03/09/2021 08:15 50091
03/09/2021 08:30 50111
03/09/2021 08:30 50111
03/09/2021 08:45 50131
03/09/2021 09:00 50151
03/09/2021 09:15 50171
03/09/2021 09:30 50189
03/09/2021 10:00 50189
03/09/2021 10:15 50189
03/09/2021 10:15 50189
03/09/2021 10:30 50189

Je vous remercie pour votre aide. Cela me facilite beaucoup la lecture des données

Cordialement,
Bastien
 
Vote positif 0 Vote négatif
S

soan

XLDnaute Barbatruc
Inactif
Bonsoir Bastien,

relis mon post #3 car j'ai modifié le texte ; télécharge de nouveau les 2 fichiers, car j'ai corrigé quelques bugs qui étaient dans l'ancienne sub Essai() ; le code VBA qui était entre balises de code a été remplacé par le nouveau code VBA. (rappel : pour les 2 fichiers, c'est le même code VBA)​

soan
 
Vote positif 0 Vote négatif
S

soan

XLDnaute Barbatruc
Inactif
Bonjour Bastien,

voici la 2ème version. :)

fais Ctrl e ➯ le nombre de lignes est passé de 2 244 à ... 47 ! 🥳

donc y'a eu 2 197 lignes en moins ! 🤩

VB: 
Option Explicit: Option Base 1

Sub Essai()
  Dim n&: n = Cells(Rows.Count, 1).End(3).Row: If n = 1 Then Exit Sub
  Dim T1, T2, DRC As Date, CPT&, r As Byte, i&, j&, k&
  n = n - 1: T1 = [A2].Resize(n, 2): ReDim T2(n, 2): j = 1
  Application.ScreenUpdating = 0: Range("A2:B" & n + 1) = Empty
  For i = 1 To n
    DRC = CDate(T1(i, 1)): r = Minute(DRC) Mod 15
    If r = 0 Then
      CPT = T1(i, 2): If j > 1 Then k = j - 1: r = -(CPT = T2(k, 2))
      If r = 0 Then T2(j, 1) = DRC: T2(j, 2) = CPT: j = j + 1
    End If
  Next i
  [A2].Resize(n, 2) = T2
End Sub

soan
 

Pièces jointes

  • Releve Compteur v2.xlsm
    52.4 KB · Affichages: 11
Vote positif 0 Vote négatif
B

Bastien43

XLDnaute Occasionnel
Bonjour,

merci beaucoup pour votre aide et la macro. C'est super. Juste une dernière demande svp. Est-il possible de garder tous les pas de temps de 15 min (même si le volume en face reste constant ?)

date 00:00:00 Volume
date 00:00:15 Volume
date 00:00:30 Volume
date 00:00:45 Volume
date 00:01:00 Volume
date 00:01:15 Volume
date 00:01:30 Volume
date 00:01:45 Volume
....

Il devrait y avoir 96 lignes à la fin pour une journée.

Si il y a 2 jours cela donnerait 96 x 2 = 192 lignes, etc.

Est-ce possible ? cela me permet ensuite de calculer le débit sur ce pas de temps de 15 min

Je vous remercie pour votre aide et votre temps.

Cordialement
Bastien
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour Bastien43, Etoto, soan,
Bastien43 à dit:
Une question : comment éviter les doublons ou données triples svp ? Est-ce possible d'avoir qu'une seule ligne pour le même quart de temps ?
Cliquez pour agrandir...
Ton dernier fichier @soan ne tient pas compte de cette contrainte.

Et il vaut mieux mettre les résultats dans une 2ème feuille contenant cette macro évènementielle :
VB: 
Private Sub Worksheet_Activate()
Dim tablo, i&, dat$, min%, n&
tablo = Feuil1.[A1].CurrentRegion.Resize(, 2) 'CodeName à adapter
For i = 1 To UBound(tablo)
    dat = Format(tablo(i, 1), "mm/dd/yyyy hh:mm") 'date au format US
    min = Val(Right(dat, 2))
    If min Mod 15 = 0 Then n = n + 1: tablo(n, 1) = dat: tablo(n, 2) = tablo(i, 2)
Next
'---restitution---
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
[A1].Resize(n, 2) = tablo '1ère cellule de destination, à adapter
[A1].Resize(n, 2).RemoveDuplicates 1, Header:=xlYes 'supprime les doublons en colonne A (ce n'est pas obligatoire)
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub
Elle se déclenche quand on active la feuille, voyez le fichier joint.

A+
 

Pièces jointes

  • Releve Compteur(1).xls
    204 KB · Affichages: 5
Vote positif 0 Vote négatif
B

Bastien43

XLDnaute Occasionnel
Bonjour,

Merci, autre façon de faire. C'est super.
Comment cela fonctionne si j'ai un fichier excel nouveau ? Avec une macro, je l'exécute rapidement avec le raccourci mais ici je devrais ajouter une nouvelle feuille dans le nouveau fichier ? ca marche automatiquement ?
Car j'ai une trentaine de fichier à traiter...
Je vous remercie pour votre aide

Bastien
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Oui il faudra une 2ème feuille avec son code pour chaque fichier, elle se créera rapidement par copie.

Notez que pour supprimer les doublons uniquement si les valeurs en A et B sont les mêmes :
VB: 
[A1].Resize(n, 2).RemoveDuplicates Array(1, 2), Header:=xlYes 'supprime les doublons des colonnes A et B (ce n'est pas obligatoire)
Fichier (2).
 

Pièces jointes

  • Releve Compteur(2).xls
    204.5 KB · Affichages: 4
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Faites l'effort de comprendre la différence qu'il y a entre la suppression des doublons du fichier (1) post #9 et la suppression des doublons du fichier (2) post #11, c'est pourtant assez évident et en plus j'ai expliqué...
 
Vote positif 0 Vote négatif
B

Bastien43

XLDnaute Occasionnel
ok merci je ne suis pas un expert.
Ce que je voulais dire, en copiant de nouvelles données dans la première feuille, cela ne donne pas un résultat fiable à 100% dans la 2e
par contre, pas moyen de le faire avec une macro ? sans 2e feuille ? ce serait plus simple.
Merci
 
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bastien43 à dit:
Ce que je voulais dire, en copiant de nouvelles données dans la première feuille, cela ne donne pas un résultat fiable à 100% dans la 2e
Cliquez pour agrandir...
C'est fiable à 100%, Excel ne fait pas dans le bricolage.
Bastien43 à dit:
par contre, pas moyen de le faire avec une macro ? sans 2e feuille ? ce serait plus simple.
Cliquez pour agrandir...
On peut bien sûr ne pas utiliser une 2ème feuille et c'est très facile, mais alors les données sources seront perdues, c'est un inconvénient.

Placez cette macro dans un module standard (Module1) :
VB: 
Sub Une_feuille()
Dim tablo, i&, dat$, min%, n&
tablo = [A1].CurrentRegion.Resize(, 2) 'feuille active
For i = 1 To UBound(tablo)
    dat = Format(tablo(i, 1), "mm/dd/yyyy hh:mm") 'date au format US
    min = Val(Right(dat, 2))
    If min Mod 15 = 0 Then n = n + 1: tablo(n, 1) = dat: tablo(n, 2) = tablo(i, 2)
Next
'---restitution---
Application.ScreenUpdating = False
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData 'si la feuille est filtrée
Columns("A:B").ClearContents 'RAZ
[A1].Resize(n, 2) = tablo '1ère cellule de destination, à adapter
[A1].Resize(n, 2).RemoveDuplicates Array(1, 2), Header:=xlYes 'supprime les doublons en colonnes A et B (ce n'est pas obligatoire)
With ActiveSheet.UsedRange: End With 'actualise la barre de défilement verticale
End Sub
C'est toujours la feuille active qui sera traitée.
 
Vote positif 0 Vote négatif
Solution

Discussions similaires

L
  • Question
XL 2016 Macro et suppressions de lignes
Réponses
9
Affichages
789
fanfan38
fanfan38
V
  • Question
XL 2019 Calculer cadence sur excel pour planning de production
Réponses
0
Affichages
6 K
Vanhoove
V
S
  • Question
XL 2010 Moyenne de n cellule en décaler
Réponses
14
Affichages
3 K
saphya
S
W
  • Question
recherche un date dans une autre feuille
Réponses
8
Affichages
5 K
skoobi
skoobi
S
  • Question
Probleme de mise en forme des données de date
Réponses
1
Affichages
829
pat1545.
P
M
[REF] Wiki 4 de MichelXld (Fonctions, Evenements, Dates et calendriers, Flash , Ooo)
Réponses
0
Affichages
35 K
MichelXld
M

Membres actuellement en ligne

Aucun membre en ligne actuellement.
0 membres et 49 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 719
Messages
2 112 183
Membres
111 456
dernier inscrit
Bologne5