Macro et Synthèse

[mouss]

Bonjour à tous,

Débutant en VBA, j'ai un petit problème concernant le traitement d'une immensitées de fichiers.
Pourriez vous m'aider dans la mesure du possible biensur.

J'ai plus au moins 1600 fichiers csv, contenant chacun plus au moins entre 10 et 15.000 lignes.
Mon premier boulot serait le traitement du fichier, pour cela je dois:

- supprimer toute les lignes dont les valeurs dans la colonne B sont inférieur à 1.
- supprimer toute les lignes dont les valeurs dans la colonne C sont supérieure à 200
- supprimer toute les lignes dont les valeurs sont la colonne I sont inférieure à 100

Sachant que la colonne B est un incrément ou chaque ligne correspont à 30 seconde, je voudrais calculé le temps réel dans une colonne P par exemple.
Une fois le fichier traité, celui ci devrait s'enregistrer dans un dossier X, reprennant tout les fichiers traité, gardant les originaux en place.

Après cela, je voudrais reprendre certains résultats dans un fichier de synthèse comme présenté dans le fichier annexe:

entre autre, une ligne reprendrai le nom du fichier traité ainsi que le temps total sachant comme dit précédement que une ligne équivaut à 30 sec.

J'ai déjà repris deux trois bout de code mais ceux ci sont très long, il faut 3min pour une macro.

Est il possible de lancer le traitement depuis le fichier analyse ?

Sub del_reltmr_1()
'Efface les lignes dont la valeur de la colonne B est inférieur à 1 seconde
For i = [B20000].End(xlUp).Row To 2 Step -1
    If Cells(i, 2) < 1 Then Rows(i).Delete
Next i
End Sub

Sub del_rloadr()
'Efface les lignes dont la valeur de la colonne C est supérieur à 200
For i = [C20000].End(xlUp).Row To 2 Step -1
    If Cells(i, 3) > 200 Then Rows(i).Delete
Next i
End Sub

Sub del_rloads()
'Efface les lignes dont la valeur de la colonne I est inférieur à 100
For i = [I20000].End(xlUp).Row To 2 Step -1
    If Cells(i, 9) < 100 Then Rows(i).Delete
Next i
End Sub

 

[mouss]

Re : Macro et Synthèse

Bonjour tout le monde, j'avance doucement sans aide, c'est pas facile
Qu'en pensez vous ?
Je voudrais maintenant pouvoir dire que la machine à été arrêtée deux fois pendant X temps, comment puis je faire ?
D'avance merci

Sub Analyse()
    
    'Fait un autofit de la colonne A
    Columns("A:A").EntireColumn.AutoFit
    'Efface les lignes dont le temps reading est inférieur à 1 seconde
    For i = [B20000].End(xlUp).Row To 2 Step -1
    If Cells(i, 2) < 1 Then Rows(i).Delete
    Next i
    'Ecris le texte suivant dans la colonne L, cellule L1 et L2
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "Hours running"
    Range("L2").Select
    ActiveCell.FormulaR1C1 = "HOURS"
    'Selectionne et calcule le temps suivant l'incrément de la colonne B
    Range("L3").Select
    ActiveCell.FormulaR1C1 = "=RC[-10]/86400"
    Selection.AutoFill Destination:=Range("L3:L20000")
    'Selectionne le range L et applique le format time
    Columns("L:L").Select
    Selection.NumberFormat = "[h]:mm:ss;@"
    'Filtre le contenu du tableau pour n'afficher que les valeurs de la colonne C inférieur à 200
    'et les valeurs de la colonne I supérieure à 100
    Range("A3:L20000").Select
        Selection.AutoFilter
    ActiveSheet.Range("$A$2:$l$20000").AutoFilter Field:=3, Criteria1:="<200", _
        Operator:=xlAnd
    ActiveSheet.Range("$A$2:$l$20000").AutoFilter Field:=9, Criteria1:=">100", _
        Operator:=xlAnd
End Sub

 

[camarchepas]

Re : Macro et Synthèse

Bonjour ,

Voici une autre solution ,

L'on ne copie que les lignes intéressantes dans un onglet provisoire.

Par contre pour la fréquence de panne et la durée, un petit exemple avec par exemple 3 lignes en affichant le résultat souhaité.

Je pense avor compris que la colonne B est un horodateur.

Mais pour les autres colonnes ?

Sub supprime()
Dim Tourne As Long, Cible As Long
Dim Nom As String
Tourne = 1
Cible = 1
Nom = "Fichier 1xx"
Workbooks.Open Filename:="c:\Temp\" & Nom
 With Workbooks(Nom & ".csv").Worksheets(Nom)
  Do
  'Ne copie pas les lignes dont la valeur de la colonne B est inférieur à 1 seconde
  'Ne copie pas les lignes dont la valeur de la colonne C est supérieur à 200
  'Ne copie pas les lignes dont la valeur de la colonne I est inférieur à 100
   If .Range("B" & Tourne) >= 1 And .Range("C" & Tourne) <= 200 And .Range("I" & Tourne) >= 100 Then
    Cible = Cible + 1
    .Rows(Tourne).Copy Destination:=ThisWorkbook.Worksheets("Temporaire").Rows(Cible)
   End If
   Tourne = Tourne + 1
  Loop Until .Range("A" & Tourne) = ""
 End With
Workbooks(Nom & ".csv").Close False
End Sub

 

[mouss]

Re : Macro et Synthèse

Bonjour Camarchepas.
Merci pour ton aide, je n'arrive pas à faire tourner ton code

Pour les explication, la colonne B est effectivement un horodateur qui compte le temps de run de la machine par incrément de 30 secondes.
Donc dans un premier temps, je supprime les valeurs qui sont inférieure à 1 ou egale à 0, peu importe.

Ma seconde étape est de trouver les arrêts de la machine, qui correspond au condition suivante. colonne C inférieur à 200 et colonne I supérieur à 100. ces colonnes corresponde à des données recu par une unitée de mesurements pour faire simple.

Une fois mes données filtrée, j'ai transformé la colonne B en temps dans la colonne L (je sais pas si c'est clair)

Maintenant c'est la que cela se complique

Temps que je retranscrit dans la colonne L.

Ce que je veux c'est dire dans mon fichier analyse, tel fichier xxx.csv a eu x arrêt machine de X heure...

 

[mouss]

Re : Macro et Synthèse

Bonjour ,

Voici une autre solution ,

L'on ne copie que les lignes intéressantes dans un onglet provisoire.

Par contre pour la fréquence de panne et la durée, un petit exemple avec par exemple 3 lignes en affichant le résultat souhaité.

Je pense avor compris que la colonne B est un horodateur.

Mais pour les autres colonnes ?

Sub supprime()
Dim Tourne As Long, Cible As Long
Dim Nom As String
Tourne = 1
Cible = 1
Nom = "Fichier 1xx"
Workbooks.Open Filename:="c:\Temp\" & Nom
 With Workbooks(Nom & ".csv").Worksheets(Nom)
  Do
  'Ne copie pas les lignes dont la valeur de la colonne B est inférieur à 1 seconde
  'Ne copie pas les lignes dont la valeur de la colonne C est supérieur à 200
  'Ne copie pas les lignes dont la valeur de la colonne I est inférieur à 100
   If .Range("B" & Tourne) >= 1 And .Range("C" & Tourne) <= 200 And .Range("I" & Tourne) >= 100 Then
    Cible = Cible + 1
    .Rows(Tourne).Copy Destination:=ThisWorkbook.Worksheets("Temporaire").Rows(Cible)
   End If
   Tourne = Tourne + 1
  Loop Until .Range("A" & Tourne) = ""
 End With
Workbooks(Nom & ".csv").Close False
End Sub

Je n'arrive vraiment pas à faire tourner ton programme
Il cherche un fichier xlsx alors que j'ai que des csv, les zorksheets porte tjrs un nom different, que puis je faire ?

 

[camarchepas]

Re : Macro et Synthèse

Mouss,

Qu'est -ce qui ne marche pas ?

as-tu mis le fichier .csv dans le répertoire c:\temp ?

Ou adaptes le chemin à ta configuration pour trouver le fichier.

:="c:\Temp\" & Nom.

Et tu verras , là ça fonctionne très bien , ça ouvre le fichier à analyser , récupere juste les lignes interessantes et referme le fichier.

 

[mouss]

Re : Macro et Synthèse

Mouss,

Qu'est -ce qui ne marche pas ?

as-tu mis le fichier .csv dans le répertoire c:\temp ?

Ou adaptes le chemin à ta configuration pour trouver le fichier.

:="c:\Temp\" & Nom.

Et tu verras , là ça fonctionne très bien , ça ouvre le fichier à analyser , récupere juste les lignes interessantes et referme le fichier.

Ah oui super, merci beaucoup, effectivement j'avais pas mon fichier dans le bon temp.
Ca tourne super merci beaucoup, je vais voir pour le reste.

 

[mouss]

Re : Macro et Synthèse

Problème résolu

 

[mouss]

Re : Macro et Synthèse

Bonjour tout le monde, voici l'avancée de mon projet.
Petite question dans l'execution de ma macro celle ci plante avec certain fichier.
A savoir que la macro ouvre le fichier dont le nom se trouve dans la cellule selectionnée
exemple Fichier 1xx.csv plante la macro, mais fichier 1xx fonctionne.
je pense c'est à cause du nom de la worksheet mais je ne sais pas comment lui dire que c'est la sheet active, quelqu'un aurait il une petite idée ?

Le nom de mes fichiers font plus de 32 caracteres
Le nom de la worksheet est dans tout les cas le nom du fichier mais tronqué à 31 caracteres...

D'avance merci

Sub supprime()
'permet de traiter le fichier nomé dans la cellule active
Dim Tourne As Long, Cible As Long
Dim Nom As String
Tourne = 1
Cible = 1
Nom = ActiveCell.Value
'Workbooks.Open Filename:="c:\Temp\" & Nom
Workbooks.Open Filename:=ActiveCell.Offset(0, 1) & Nom
With Workbooks(Nom & ".csv").Worksheets(Nom)

 

[camarchepas]

Re : Macro et Synthèse

Bonjour Mouss,

Remplace With Workbooks(Nom & ".csv").Worksheets(Nom)
par With Workbooks(Nom & ".csv").activesheet

 

[mouss]

Re : Macro et Synthèse

Bonjour Camarchepas, merci pour ton aide, cela fonctionne, j'avais reussis comme ceci:

With Workbooks(Nom & "").Worksheets(ActiveSheet.Name)

Le tiens est plus simple

Je suis confronté un autre problème maintenant, certains fichiers ne sont pas arrangé de la même facon.
j'entend par la que la colonne B du fichier 1 n'est pas forcement la même que la colonne B du fichier 2.
La seule chose en commun entre les fichiers ce sont les titres au dessus des colonnes qui sont tjrs les même mais pas au même endroit.

Ce que je voudrais faire c'est remettre toute les colonnes dans un ordre prédéfini afin de calculer avec les bonnes valeurs dans la sheet temporaire

Exemple:

Fichier 1

Ligne A1: Absolute time
ligne A2: ABSTMR
Ligne B1: Relative time
Ligne B2: RELTMR
Ligne C1:Speed(R)
Ligne C2:SPEEDR
...
...
...

Fichier 2

Ligne A1: Absolute time
ligne A2: ABSTMR
Ligne B1: Relative time
Ligne B2: RELTMR
Ligne C1:Room Temperature(R)
Ligne C2:RTEMPR
Ligne D1:Speed(R)
Ligne D2:SPEEDR
...
...
...

 

[camarchepas]

Re : Macro et Synthèse

Bonjour,

Réponse tardive, j'espère qu'elle te sera quand même utile.

Voici pour le début,

Je ne comprend pas à quoi sert le tri ?

Sub Test()
 
 Dim DerCol As Integer, Boucle As Integer
 Dim Tourne As Long, Cible As Long
 Dim Num_Liste As Byte
 Dim Référence As String
 Dim Elément() As String
' Dim Nom As String
' Dim Cel As Range
' Dim Unique As New Collection
'
Référence = "ABSTMR|RELTMR|RLOADR|SPEEDR|DISTAR|RLOADS|SPEEDS"
Elément = Split(Référence, "|")
'Mise en référence feuille active
 With ActiveSheet
  
  'Conserver les données utiles
   DerCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
   For Boucle = DerCol To 1 Step -1
    If .Cells(1, Boucle).Value <> "" Then
     If InStr(1, Référence, .Cells(1, Boucle).Value) = 0 Then .Columns(Boucle).Delete
    End If
   Next Boucle
     
  'Récupèration du numéro de la liste personnelle dans Outils/Options/Listes Persos
   Num_Liste = Application.GetCustomListNum(Elément)
   If Num_Liste = 0 Then
    ' Si elle n'existe pas
     Application.AddCustomList ListArray:=Array(Elément)
     ' on ajoute la liste personnelle
     Num_Liste = Application.CustomListCount
     ' on récupère le numéro de la liste personnelle
     '(tout ajout de liste personnelle étant à la fin,
     ' ce sera donc la dernière)
   End If
  end with
 End Sub

 

[mouss]

Re : Macro et Synthèse

Bonjour Camarchepas.

Tout avis est bon à prendre cela me permet d'avancer
Merci pour ton aide.

Le programme fonctionne, pas trop mal, seullement j'ai une petite erreur, au niveau du comptage des valeurs unique, il m'en compte tjrs une de trop, de quoi cela pourrait il venir ? il compte les cellules vide comme valeur unique égallement ?

voici la macro:

Sub Analyse()
 
Dim DerCol As Integer, Boucle As Integer
Dim Num_Liste As Byte
Dim Référence As String
Dim Elément() As String
Dim Nom As String
Dim Cel As Range
Dim Unique As New Collection
Référence = "ABSTMR|RELTMR|RLOADR|SPEEDR|DISTAR|RLOADS|SPEEDS"
Elément = Split(Référence, "|")
Nom = ActiveCell.Value

'efface le contenu de la sheet temporaire avant toute chose
Sheets("Temporaire").Select
Range("A3").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.ClearContents
Sheets("Analyse").Select

'Mise en référence feuille active
Workbooks.Open Filename:=ActiveCell.Offset(0, 1) & Nom
With Workbooks(Nom & "").ActiveSheet

    'Fait un autofit de la colonne A
    Columns("A:A").EntireColumn.AutoFit
    'Conserver les données utiles
    DerCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
    For Boucle = DerCol To 1 Step -1
        If .Cells(2, Boucle).Value <> "" Then
            If InStr(1, Référence, .Cells(2, Boucle).Value) = 0 Then .Columns(Boucle).Delete
        End If
    Next Boucle
     
    'Récupèration du numéro de la liste personnelle dans Outils/Options/Listes Persos
    Num_Liste = Application.GetCustomListNum(Elément)
    If Num_Liste = 0 Then
        ' Si elle n'existe pas
        Application.AddCustomList ListArray:=Array(Elément)
        'on ajoute la liste personnelle
        Num_Liste = Application.CustomListCount
        'on récupère le numéro de la liste personnelle
        'tout ajout de liste personnelle étant à la fin,ce sera donc la dernière
    End If
        
    'On remet les colonnes dans le bon ordre
    With Range("A1:W" & [A25000].End(xlUp).Row)
    .Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo, OrderCustom:=Num_Liste + 1, _
    Orientation:=xlLeftToRight
    End With
    
    'execution de la macro supprime
    Application.Run ("supprime")

Workbooks(Nom & "").Close False

    'Calcule le temps de run
    Sheets("Temporaire").Select
    Range("G3").Select
    If Cells(3, 7).Value <> "" Then
        Selection.End(xlDown).Select
        ActiveCell = ActiveCell.Offset(0, 1).Select
        ActiveCell.FormulaR1C1 = "=RC[-6]/86400"
        Selection.AutoFill Destination:=Range("H3:H" & Range("G" & Rows.Count).End(xlUp).Row)
    
        'Selectionne le range H et applique le format time
         Range("H3").Select
         Range(Selection, Selection.End(xlDown)).Select
         Selection.NumberFormat = "[h]:mm:ss;@"

         ' compte le nombre de valeur unique dans le range
         On Error Resume Next
         For Each Cel In Range("E3:E25000")
         Unique.Add Cel.Value, CStr(Cel.Value)
         Next Cel
         On Error GoTo 0
    
         'affiche le nombre de valeur unique
         Sheets("Analyse").Select
         ActiveCell.Offset(0, 2).Select
         ActiveCell.FormulaR1C1 = Format(Unique.Count, "")
    Else

        If Cells(3, 7).Value = "" Then
        Sheets("Analyse").Select
        ActiveCell.Offset(0, 2).Select
        ActiveCell.FormulaR1C1 = "pas d'erreur"
        End If
        
    End If
    
End With
End Sub

Sub supprime()
Dim Tourne As Long, Cible As Long
'Dim Nom As String
Tourne = 2
Cible = 2
 With ActiveSheet
  Do
  'Ne copie pas les lignes dont la valeur de la colonne B est inférieur à 1 seconde
  'Ne copie pas les lignes dont la valeur de la colonne C est supérieur à 200
  'Ne copie pas les lignes dont la valeur de la colonne F est inférieur à 100
   If .Range("B" & Tourne) >= 1 And .Range("C" & Tourne) <= 200 And .Range("F" & Tourne) >= 100 Then
    Cible = Cible + 1
    .Rows(Tourne).Copy Destination:=ThisWorkbook.Worksheets("Temporaire").Rows(Cible)
   End If
   Tourne = Tourne + 1
  Loop Until .Range("A" & Tourne) = ""
 End With

End Sub

Sub ListDirectory()
'
Dim mess As String, mess2 As String, répertoire As String
Dim i As Variant
'Columns(1).Clear
'Columns(2).Clear
mess = InputBox("Chemin complet du répertoire à explorer", "Chemin du répertoire", _
"C:\TEMP\")
mess2 = InputBox( _
"Quelle extension de fichiers cherches tu ? (pdf, xls, doc, jpg, dxf etc...)" _
, "TYPE DE FICHIER", "csv")
Application.ScreenUpdating = False
répertoire = Dir(mess & "*" & mess2, vbDirectory)
Do While répertoire <> ""
i = i + 1
ActiveCell(i + 1, 1) = répertoire
ActiveSheet.Hyperlinks.Add Anchor:=ActiveCell(i + 1, 2), Address:=mess & répertoire
ActiveCell(i + 1, 2) = mess
répertoire = Dir
Loop
Range("B:B").EntireColumn.Hidden = True
End Sub

 

[mouss]

Re : Macro et Synthèse

C'est bon problème reglé

         ' compte le nombre de valeur unique dans le range
         On Error Resume Next
         For Each Cel In Range("E3:E" & [E25000].End(xlUp).Row)
         Unique.Add Cel.Value, CStr(Cel.Value)
         Next Cel
         On Error GoTo 0
    
         'affiche le nombre de valeur unique
         Sheets("Analyse").Select
         ActiveCell.Offset(0, 2).Select
         ActiveCell.FormulaR1C1 = Format(Unique.Count, "")
Else

        If Cells(3, 7).Value = "" Then
        Sheets("Analyse").Select
        ActiveCell.Offset(0, 2).Select
        ActiveCell.FormulaR1C1 = "pas d'erreur"
        End If

par contre j'ai un soucis avec ma synthaxe de selection je pense, quand je n'ai que une seule valeur dans la colonne E, et précisement la cellule E3 ca plante.

If Cells(3, 7).Value <> "" Then
        Selection.End(xlDown).Select
        ActiveCell = ActiveCell.Offset(0, 1).Select
        ActiveCell.FormulaR1C1 = "=RC[-6]/86400"
        Selection.AutoFill Destination:=Range("H3:H" & Range("G" & Rows.Count).End(xlUp).Row)
        'Selection.AutoFill Destination:=Range("H3:H" & [H25000].End(xlUp).Row)

Pour expliquer en gros, la colonne H je calcule un temps via une formule.
En l'occurence la valeur de la cellule B de la même ligne divisé par 86400.
Je dois copier cette formulle dans toute les cellules H des lignes qui on des valeurs.
D'ou l'autofill et la selection en G...

 

[camarchepas]

Re : Macro et Synthèse

Bonsoir,

Petite question concernant une macro que tu as ecrite pour moi, je voudrais savoir si il est possible de modifier un peu le codage pour faire cette fonction

En gros voila, je voudrais que si une ligne correspond aux criteres, que celle ci soit copier dans la sheet temporaire, mais egalement la ligne du dessus

Voici :

Sub supprime()
Dim Tourne As Long, Cible As Long
'Dim Nom As String
Tourne = 2
Cible = 2
 With ActiveSheet
  Do
  'Ne copie pas les lignes dont la valeur de la colonne B est inférieur à 1 seconde
  'Ne copie pas les lignes dont la valeur de la colonne C est supérieur à 200
  'Ne copie pas les lignes dont la valeur de la colonne F est inférieur à 100
   If .Range("B" & Tourne) >= 1 And .Range("C" & Tourne) <= 200 And .Range("F" & Tourne) >= 100 Then
  
'Modif ici
    Cible = Cible + 1
    .Rows(Tourne - 1).Copy Destination:=ThisWorkbook.Worksheets("Temporaire").Rows(Cible)
' Fin modif

    Cible = Cible + 1
    .Rows(Tourne).Copy Destination:=ThisWorkbook.Worksheets("Temporaire").Rows(Cible)
   End If
   Tourne = Tourne + 1
  Loop Until .Range("A" & Tourne) = ""
 End With

End Sub