XL 2013 Recherche dans fichiers par intervalle de dates

[GSueur]

Bonjour à tous !

J'ai créé il y quelque temps un fichier Excel de recherche de données. En effet les données étant classées par date et heure, l'utilisateur rentre la date et l'heure de début et de fin de l'intervalle, appuie sur le bouton recherche et le programme VBA ouvre tous les classeurs excel du dossier et lit toutes les lignes (environ 3000 lignes par classeurs). Si la date lue est dans l'intervalle rentré par l'utilisateur, la ligne de données est recopié dans le fichier de recherche. Ensuite, j'ai ajouté un graphique qui trace les données récoltées pour une utilisation plus intuitive.

Cependant, mon programme ne fonctionne que sur des des intervalles de recherche assez court (1 h par ex). Lorsque je lance une recherche avec un intervalle compris par exemple entre le 17/06/2016 à 23 h et le 18/06/2016 à 1 h, le programme bug.

Malgré mes efforts, je n'arrive pas à trouver le problème.

Je sais que je demande beaucoup... mais merci de m'aider. C'est un projet très important pour moi en tant que stagiaire.

Je joins quelques fichiers de données comme ceux que j'ai en grand nombre dans le dossier ainsi que le fichier recherche que j'ai réalisé.
Le chemin du dossier de recherche dans le programme correspond à mon PC, il vous faut bien sûr le changer pour effectuer des tests sur votre PC.

Merci d'avance !

 

[gosselien]

Bonjour,

et on cherche où ? les fichiers sont vides ....

P.

 

[GSueur]

Les fichiers dans lesquels chercher les informations sont dans dans la pièce jointe "ligne3". C'est le dossier qui regroupe tous mes classeurs excel générés par un automate.

 

[gosselien]

Les fichiers dans lesquels chercher les informations sont dans dans la pièce jointe "ligne3". C'est le dossier qui regroupe tous mes classeurs excel générés par un automate.

Oupss...sorry je n'avais pas vu le zip

 

[job75]

Bonjour GSueur, gosselien,

Si les feuilles à traiter sont identiques (ce n'est pas le cas de "Ligne4") et si les noms des fichiers csv sont toujours de la forme aammjj on peut utiliser une seule macro, à placer dans un module standard :

Sub Recherche()
If Left(ActiveSheet.Name, 5) <> "Ligne" Then Exit Sub
Dim chemin$, fich$, d1&, h1#, d2&, h2#, deb As Range, d, t, n&, i&, h#, j%
chemin = ThisWorkbook.Path & "\" 'à adapter
fich = Dir(chemin & ActiveSheet.Name & "\*.csv") '1er fichier du sous-dossier
d1 = [A2]: h1 = d1 + [B2]: d2 = [A3]: h2 = d2 + [B3]
Set deb = [A28]
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si un fichier est déjà ouvert
deb.Resize(Rows.Count - deb.Row + 1, 7) = "" 'RAZ
While fich <> ""
  d = Mid(fich, 5, 2) & "/" & Mid(fich, 3, 2) & "/" & Left(fich, 2)
  If IsDate(d) Then
    d = CDbl(CDate(d))
    If d >= d1 And d <= d2 Then
      With Workbooks.Open(chemin & ActiveSheet.Name & "\" & fich)
        With .Sheets(1).[A1].CurrentRegion
          .Columns(1).TextToColumns .Cells(1), xlDelimited, Semicolon:=True, Other:=False
          t = .Offset(1).Resize(, 7)
          n = 0
          For i = 1 To UBound(t) - 1
            h = t(i, 1) + t(i, 2)
            If h >= h1 And h <= h2 Then
              n = n + 1
              For j = 1 To 6
                t(n, j) = t(i, j)
              Next
              t(n, 7) = fich
            End If
          Next
          If n Then 'restitution
            deb.Resize(n, 7) = t
            Set deb = deb(n + 1)
          End If
        End With
        .Close False
      End With
    End If
  End If
  fich = Dir 'fichier suivant du sous-dossier
Wend
Range("A28:G" & Rows.Count).Sort [A28], , [B28], Header:=xlNo 'tri
End Sub

Nota 1 : les sous-dossiers comme "ligne3" doivent être placés dans le même répertoire que "recherche.xlsm".

Nota 2 : pour les graphiques il n'y a pas besoin de code VBA, il faut définir dynamiquement les plages utilisées par les séries, avec des noms différents pour chaque feuille.

A+

 

[gosselien]

Bonjour job75,

cette ligne ne donne rien:

fich = Dir(chemin & Trim(ActiveSheet.Name) & "\*.csv") '1er fichier du sous-dossier

tous les fichiers sont dans le même répertoire pourtant (xlm et csv)

remplacée par: fich = Dir(chemin & "\*.csv") '1er fichier du sous-dossier

P.

 

[job75]

Re,

Alors gosselien on roupille ?

tous les fichiers sont dans le même répertoire pourtant (xlm et csv)

Ce n'est pas du tout ce que j'ai dit.

Au Nota 1 je parle bien du sous-dossier "ligne3"...

Edit : je viens d'enlever le Trim, le nom de la feuille ne doit pas avoir d'espace superflu, c'est tout.

A+

 

[job75]

Re, avant d'aller dormir,

Notez que les feuilles Ligne2 Ligne3 Ligne4 sont mal fichues en ce qui concerne la dernière cellule.

Supprimez les lignes 28 à 30000 et mettez toute la colonne A au format Date, toute la colonne B au format Heure.

Bonne nuit.

 

[job75]

Bonjour GSueur, gosselien, le forum,

Je me suis occupé du graphique (uniquement pour la feuille Ligne3).

J'ai inséré une colonne A qui reçoit la somme Date + Heure.

La macro modifiée pour traiter cette colonne supplémentaire :

Sub Recherche()
If Left(ActiveSheet.Name, 5) <> "Ligne" Then Exit Sub
Dim chemin$, fich$, d1&, h1#, d2&, h2#, deb As Range, d, t, rest(), n&, i&, h#, j%
chemin = ThisWorkbook.Path & "\" 'à adapter
fich = Dir(chemin & ActiveSheet.Name & "\*.csv") '1er fichier du sous-dossier
d1 = [B2]: h1 = d1 + [C2]: d2 = [B3]: h2 = d2 + [C3]
Set deb = [A28]
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si un fichier est déjà ouvert
deb.Resize(Rows.Count - deb.Row + 1, 8) = "" 'RAZ
While fich <> ""
  d = Mid(fich, 5, 2) & "/" & Mid(fich, 3, 2) & "/" & Left(fich, 2)
  If IsDate(d) Then
    d = CDbl(CDate(d))
    If d >= d1 And d <= d2 Then
      With Workbooks.Open(chemin & ActiveSheet.Name & "\" & fich)
        With .Sheets(1).[A1].CurrentRegion
          .TextToColumns .Cells(1), xlDelimited, Semicolon:=True, Other:=False
          t = .Offset(1).Resize(, 8)
          ReDim rest(1 To UBound(t), 1 To 8)
          n = 0
          For i = 1 To UBound(t) - 1
            h = t(i, 1) + t(i, 2)
            If h >= h1 And h <= h2 Then
              n = n + 1
              rest(n, 1) = h 'Date/heure en colonne A
              For j = 1 To 6
                rest(n, j + 1) = t(i, j)
              Next
              rest(n, 8) = fich 'facultatif, nom du fichier en colonne H
            End If
          Next
          If n Then 'restitution
            deb.Resize(n, 8) = rest
            Set deb = deb(n + 1)
          End If
        End With
        .Close False
      End With
    End If
  End If
  fich = Dir 'fichier suivant du sous-dossier
Wend
Range("A28:H" & Rows.Count).Sort [A28], Header:=xlNo 'tri
With ActiveSheet.UsedRange: End With 'actualise les barres de défilement
End Sub

Voyez les noms définis dynamiquement Ligne3_DateHeure Ligne3_TA Ligne3_TB Ligne3_Vitesse.

Fichier joint.

Bonne journée.

 

[job75]

Re,

Notez que si l'on veut afficher l'axe des abscisses (catégories) il faut :

- afficher la colonne A - je lui ai donné une largeur de 0,1

- formater cette colonne en heures ou en dates.

Voyez les fichiers joints.

A+

 

[GSueur]

Bonjour à tous,

Merci pour votre aide, ça marche super pour toutes les lignes!!
De plus l’exécution est beaucoup plus rapide qu'auparavant.

Par contre job75, je n'arrive pas à gérer les graphiques de "ligne 2" et "ligne 4", je n'ai pas bien compris comment tu as fait pour le graphique de la feuille 3, peux-tu me réexpliquer brièvement stp ?

merci d'avance

 

[job75]

Bonjour GSueur,

Vous n'aurez pas de "brèves" explications si vous ne connaissez rien aux graphiques.

C'est à vous de dire ce que vous ne comprenez pas dans les post #9 et #10, pourtant clairs.

A+

 

[GSueur]

J'ai bien créé les noms dynamiquement comme mentionné dans le post 9, ensuite je me rends sur le graphique pour modifier les plages de données mais cette erreur apparaît :

 

[GSueur]

Re bonjour à tous !!

Je n'ai toujours pas trouvé de solutions concernant le problème cité au post 13,

Aidez moi svp, je suis bloqué sur ce projet

Merci d'avance

 

[job75]

Bonjour GSueur,

Je n'avais pas vu passer votre post #13...

1) Le message d'erreur se produisait quand la base de données était vide mais ce n'était pas grave.

Cependant pour pour l'éviter j'ai ajouté la fonction MAX(xxx;1) dans les définitions de Ligne2_DateHeure et Ligne3_DateHeure :

=DECALER(Ligne2!$A$28;;;MAX(NBVAL(Ligne2!$A:$A)-NBVAL(Ligne2!$A$1:$A$27);1))

2) Par contre le graphique reste vide certainement parce que votre chemin d'accès :

chemin = "U:\MPC\Datalogger\logs\"

n'est pas correct.

Le dernier dossier de la chaîne (c'est à dire "logs") doit contenir les sous-dossiers "ligne2" et/ou "ligne3" qui eux-mêmes contiennent directement les fichiers csv.

J'ai testé le fichier avec le chemin d'accès ThisWorkbook.Path & "\" et tout va très bien.

Fichiers zippés joints, faites bien attention quand vous les décompressez.

Edit : ah oui j'ai corrigé votre erreur pour le graphique de la feuille "Ligne2".

Vous aviez défini les 3 séries à partir de Ligne3_TA, Ligne3_TB et Ligne3_Vitesse !!!

A+