A propos VBA Excel Fermé

Question

Bonjour,
j'ai un fichier qui contien des données brut contenant des mesures OMC dont la taille est trés grande environ "10 giga"
je pu le decomposer en des fichiers excel de petite taille contenant l'ensemble des informations bien sur les informations sont en continuité 
Le fichier contien des date, des compteurs (heure,minute,secondes,millième de secondes), des caractères, des symboles (%,_,-,...) bref tous 
Problèmes:
je voudrai utiliser le VBA sous excel pour lire l'ensemble des fichiers que j'ai enregistrer sous les noms "test1, test2,test3,...testn" choisir la colonne sur laquelle je veut travailler "la colonne va se poursuivre sur tous les autres fichiers " c'est à dire elle commence de test1 et fini avec testn.
Une fois le fichier  lu je voudrai réaliser des opérations telque "somme, soustraction,division,..."
Je veut faire ces opération en mettant des conditions c'est a dire pour une colonne si on arrive a une certaine positions on arrete le calcul.

1 partie : lire la colonne de la variable voulu dans tous les fichiers d'une facon successive
2 parite: realiser une soustraction entre deux colonnes B1 et D1 avec la condition que si on arrive a une certaine possition on fé la somme des valeurs trouvé et on divise/3600
la forme des deux colonnes et la suivante (0:00:01:338,0:00:01:328) c'est a dire je lit ces deux colonnes chacune a part je fé la soustraction entre la date de fin et la date d'arrivé et si j'arrive à la fin de chaque heure 0:01:00:000 je fé sortir la somme de la différence/3600
3 partie représenter les point obtenu par des bar 
MErci et si il y 'a quelqu'un qui a une solution je voudrai bien lui donnée tous les detail nécessaire meme l'exemple du fichier que je veut traiter

gbinforme · Answer

bonjour

Comme c'est une application complète et très conséquente que tu cherches à faire, c'est difficile de te fournir un canevas précis car il faudrait qu'il tienne compte de la structure des données précise qu'il difficile d'appréhender sans avoir les classeurs.

C'est un développement tout de même assez conséquent à faire car il faut gérer les classeurs (fermés probablement)
et créer une structure de classeur pour gérer les regroupements effectués.

Bon courage.

Utilisateur anonyme · Answer

Bonjour,


Quelques suggestions ...

Comme toute solution algorithmique, il est souhaitable de décomposer les étapes une par une.
" Diviser pour mieux règner ".

1.) Établir la structure des données visé, et créér un objet de type personnalisé pour la manipulation.
2.) Repérer le répertoire visé contenant tous les fichiers Excels.
3.) Faire une boucle pour ouvrir/fermer tous les fichiers du répertoire.
4.) Inclure dans la boucle une fonction de lecture d'une partie du classeur.
5.) Dans la fonction de lecture, inclure une sous-fonction pour le calcul
6.) Dans la fonction de lecture, inclure une sous-fonction pour les manipulations.

Ma méthode est toujours basé sur le concept des poupées russes.

Très petite poupée dans Petite poupée
Petite poupée dans Poupéé
Poupée dans Grande poupée
Grande poupée dans Très grande poupée.

Donc il n'est pas facile d'ouvrir la Très petite poupée sans avoir au préalable ouvert
toute les autres. Il faut donc commencer par ouvrir la Très grande poupée.

Il en est de même en programmation, procède par étape en commençant par la chose
la plus simple à faire, jusqu'a te rendre à la plus complexe.

Structure de données :

[ date, des compteurs (heure,minute,secondes,millième de secondes), des caractères, des symboles (%,_,-,...) ]

exemple type sur la lecture des données


Option Explicit

Type MonData
        LaDate As Date
        LeCompteur As Long
        Lheure As Long
        LaMinute As Long
        LaSeconde As Long
        LaMilliSeconde As Long
        LeCaractere As String
        LeSymbole As String
End Type

Dim Boite() As MonData

Sub Lecture()

    Dim Plage As Range, Cellule As Range, Compteur As Long
    
    Set Plage = Range("A1:A100")
    
    Compteur = 0
    For Each Cellule In Plage
        Compteur = (Compteur + 1)
        ReDim Preserve Boite(Compteur)
        Boite(Compteur - 1).LaDate = Cellule.Offset(0, 0).Value
        Boite(Compteur - 1).Lheure = Cellule.Offset(0, 1).Value
        Boite(Compteur - 1).LaMinute = Cellule.Offset(0, 2).Value
        Boite(Compteur - 1).LaSeconde = Cellule.Offset(0, 3).Value
        Boite(Compteur - 1).LaMilliSeconde = Cellule.Offset(0, 4).Value
        Boite(Compteur - 1).LeCaractere = Cellule.Offset(0, 5).Value
        Boite(Compteur - 1).LeSymbole = Cellule.Offset(0, 6).Value
    Next Cellule
    
    Call CalculPerso
    
End Sub
'

Sub CalculPerso()

    Dim Boucle As Long
    
    For Boucle = 0 To (UBound(Boite) - 1)
        ' Manuipulation et/ou calcul
    Next Boucle
    
End Sub
'


Lupin

Utilisateur anonyme · Answer

re :

Il me sera difficile de te guider n'ayant pas encore la version 2007, je suis actuellement
sour la version 2002. Toutefois voici quelques trucs.

Il te faudra trouver comment lancer l'enregistreur de macro et apprendre à l'utiliser.

Sous la version 2002 :

// Menu Excel / Outils / Nouvelle macro ...

Donc en procédant par étape, pas à pas, tu lance l'enregistreur de macro,
une nouvelle barre d'outils apparaît qui te permettra d'arrêter l'enregistrement.
Tu effectue quelques étapes que tu veux automatiser (pas trop à la fois).

Ensuite tu va dans l'editeur VBE.

// Menu Excel / Outils / Visual Basic Editor

Dans le nouvelle fenêtre, dans la partie de gauche, tu repère le nom de ton classeur de base
et sous celui-ci tu y trouveras un module portant généralement le nom de [ Module1 ]

Un double clic ouvrira dans le partie de droit la ou les macros enregistrer.

Effectue un copier/coller du code ici, et je ferai ce que je peux. Il est à noter
que je ne suis pas toujours disponible, mais je fais ce que je peux :-)

Lupin

Aymen · Answer

Vrément un grand merci d'avoir consacré un peut de votre temps pour m'aider 
bon j'ai essayer de tester le code ca a pas marché il y a affichage de quelques erreures que j'ai essayer de resoudre 
et j'ai pas pu 
donc je vous envoi en attache un exemple du fichier que je traite c'est une petite partie parceque le fichier que je traite a une taille de 10giga
donc s'il vous plait si vous pouvez faire quelque chose 
merci et mille fois merci
je voulais t'envoyé une partie du fichier pour le voire si vous pouvez me donné votre mail ainsi je pourrer t'envoié ce fichier

Utilisateur anonyme · Answer

Bonjour,

Malheureusement, à cause des problèmes soulevés par le SPAM,
je conserve mon adresse courriel confidentiel.

Mais as-tu réussit a déclencher l'enregistreur de macro et de généré
ainsi du code, si oui fait un copier/coller du code ici, je regarderai
comment je puis t'aider.

Lupin

Utilisateur anonyme · Answer

Bonjour, Première observation : Il n'est pas nécessaire de spécifier la feuille lorsque cell-ci est sélectionné. Sheets("Feuil2").Select ActiveSheet.Range("$A$1:$AN$10000").AutoFilter Field:=2, Criteria1:= _ ">0:02:00:000", Operator:=xlAnd, Criteria2:="<0:03:00:000" peut se simplifier par : Sheets("Feuil2").Select Range("$A$1:$AN$10000").AutoFilter Field:=2, Criteria1:= _ ">0:02:00:000", Operator:=xlAnd, Criteria2:="<0:03:00:000" Et voici un code déjà pondu antérieurement qui permet de sélectionner un dossier cible et d'ouvrir les fichier Excel un à un afin d'en importer le contenu (copier/coller). Celui-ci bien sur n'est pas codé spécifiquement pour vos besoins, mais constitue une bonne base pour effectuer ce que vous souhaité réalisé. Option Explicit Const cteExcel = ".xls" Const cte_Fle = "NomDeFeuilleACopier" Const cte_Global = "FichierGlobal.xls" Private Const BIF_RETURNONLYFSDIRS = 1 Private Const BIF_DONTGOBELOWDOMAIN = 2 Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, _ ByVal lpBuffer As String) As Long Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, _ ByVal lpString2 As String) As Long Private Type BrowseInfo hWndOwner As Long pIDLRoot As Long pszDisplayName As Long lpszTitle As Long ulFlags As Long lpfnCallback As Long lParam As Long iImage As Long End Type ' Sub ImporteClasseurs() Dim NomFichier As String, NomRepertoire As String Dim NomLecteur As String, ListeFichiers() As String Dim varFichier As Variant, Boucle As Long Dim Repertoire As String, Message As String Dim Reponse As Boolean Application.ScreenUpdating = False Application.DisplayAlerts = False NomRepertoire = SelectFolder("Sélectionner le répertoire des fichiers Excel à importer :", 0) NomLecteur = Mid(NomRepertoire, 1, 1) ChDrive (NomLecteur) Repertoire = Mid(NomRepertoire, 3) ChDir (Repertoire) Boucle = 0 varFichier = Dir("*" & cteExcel, vbDirectory) Do While varFichier <> "" If ((varFichier <> ".") And (varFichier <> "..")) Then If Not ((GetAttr(varFichier) And vbDirectory) = vbDirectory) Then Boucle = (Boucle + 1) ReDim Preserve ListeFichiers(Boucle) ListeFichiers(Boucle - 1) = varFichier End If End If varFichier = Dir Loop If (UBound(ListeFichiers) > 0) Then Application.Workbooks.Add ActiveWorkbook.SaveAs cte_Cumul_Global Reponse = EnteteColonne(ListeFichiers(0)) If (Reponse) Then ActiveWorkbook.SaveAs cte_Global For Boucle = 0 To UBound(ListeFichiers) - 1 ImporteFichier ListeFichiers(Boucle) Next Boucle ActiveWorkbook.SaveAs cte_Global Else Message = "" Message = Message & "Aucun fichier n'a été trouvé" & vbLf Message = Message & "dans le répertoire cible !" & vbLf Message = Message & vbLf Message = Message & "Vérifié et corriger la situation." & vbLf Message = Message & vbLf MsgBox Message End If Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub ' Private Function ImporteFichier(ByVal NomClasseur As String) Dim strNomFle As String, Limite As Long, Position As Long Dim Reponse As Boolean Application.EnableEvents = False Workbooks.Open Filename:=NomClasseur Application.EnableEvents = True Reponse = ChercheFeuille(strNomFle) If (Reponse) Then Sheets(strNomFle).Select Limite = Range("A65536").End(xlUp).Row Rows("2:" & Limite).Select Selection.Copy Workbooks(cte_Global).Activate Position = (Range("A65536").End(xlUp).Row + 1) Range("A" & Position).Select ActiveSheet.Paste Application.CutCopyMode = False Range("A1").Select Workbooks(NomClasseur).Activate ActiveWorkbook.Close End If End Function ' Private Function ChercheFeuille(ByRef NomFle As String) As Boolean Dim fleFeuille As Worksheet For Each fleFeuille In Worksheets If (InStr(1, fleFeuille.Name, cte_Fle, vbTextCompare) > 0) Then NomFle = fleFeuille.Name ChercheFeuille = True Exit For End If Next End Function ' Private Function SelectFolder(Titre As String, Handle As Long) As String Dim lpIDList As Long, strBuffer As String Dim strTitre As String, tBrowseInfo As BrowseInfo strTitre = Titre With tBrowseInfo .hWndOwner = Handle .lpszTitle = lstrcat(strTitre, "") .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN End With lpIDList = SHBrowseForFolder(tBrowseInfo) If (lpIDList) Then strBuffer = String(260, vbNullChar) SHGetPathFromIDList lpIDList, strBuffer SelectFolder = Left(strBuffer, InStr(strBuffer, vbNullChar) - 1) End If End Function ' Poser les questions qui vous viendront à l'esprit et je tenterai d'y répondre, un pas à la fois car je ne suis pas toujours connecter sur commentcamarche. Lupin

Utilisateur anonyme · Answer

re : Effectivement la partie : If (UBound(ListeFichiers) > 0) Then Application.Workbooks.Add ActiveWorkbook.SaveAs cte_Cumul_Global Reponse = EnteteColonne(ListeFichiers(0)) If (Reponse) Then ActiveWorkbook.SaveAs cte_Global For Boucle = 0 To UBound(ListeFichiers) - 1 ImporteFichier ListeFichiers(Boucle) Next Boucle ActiveWorkbook.SaveAs cte_Global Else Message = "" Message = Message & "Aucun fichier n'a été trouvé" & vbLf Message = Message & "dans le répertoire cible !" & vbLf Message = Message & vbLf Message = Message & "Vérifié et corriger la situation." & vbLf Message = Message & vbLf Message = Message & "Merci de votre attention." & vbLf Message = Message & vbLf MsgBox Message End If doit être remplacé par : If (UBound(ListeFichiers) > 0) Then Application.Workbooks.Add ActiveWorkbook.SaveAs cte_Global For Boucle = 0 To UBound(ListeFichiers) - 1 ImporteFichier ListeFichiers(Boucle) Next Boucle ActiveWorkbook.SaveAs cte_Global Else Message = "" Message = Message & "Aucun fichier n'a été trouvé" & vbLf Message = Message & "dans le répertoire cible !" & vbLf Message = Message & vbLf Message = Message & "Vérifié et corriger la situation." & vbLf Message = Message & vbLf Message = Message & "Merci de votre attention." & vbLf Message = Message & vbLf MsgBox Message End If C'est dans cette section qu'il créé la liste des fichiers Excel trouvés : Boucle = 0 ' Ici le recherche cible seulement les fichier de type [ .xls ] -> ref.: [ cteExcel ] varFichier = Dir("*" & cteExcel, vbDirectory) Do While varFichier <> "" If ((varFichier <> ".") And (varFichier <> "..")) Then If Not ((GetAttr(varFichier) And vbDirectory) = vbDirectory) Then Boucle = (Boucle + 1) ReDim Preserve ListeFichiers(Boucle) ListeFichiers(Boucle - 1) = varFichier End If End If varFichier = Dir Loop sous Excel 2002, cette partie fonctionne très bien ??? Exécute la routine en mode pas à pas ! // Menu Excel / Outils / Macro... Sélectionne le bouton [ Pas à pas détaillé ]. en survolant les variables avec la souris, une infobulle apparaît avec le contenu de la variable. de plus tu peux ajouter un espion sur la variable. Clic droit sur la variable / Sélectionne [ Ajouter un espion... ]. Tel que spécifié dans l'un de mes messages précédent, je ne connais pas les variantes de Excel 2007. Il te faudra fouillé un peu [ Google ] Lupin

Utilisateur anonyme · Answer

re : Lire dans un fichier fermé !!! Voir ici : http://excelabo.net/ Il y a plein d'exemple à ce sujet ! Toutefois, tu n'est pas obligé d'ouvrir tous les fichiers en même temps, il est possible de le ouvrir un à un en y faisant le traitement souhaité sans faire afficher les opérations exécuté. Sub OuvrirFermer() Application.ScreenUpdating = False Workbooks.Open "test4.xls" ' Traitement, ex recherche et sommation des heures ActiveWorkbook.Close Application.ScreenUpdating = True End Sub Voici les recherches opérées sur les 50 fichiers de [ test4.xls ] à [ test54.xls ] pour la 7 ième heure. Option Explicit Sub Calcul_7Hre() Dim Boucle As Long Dim NomFichier As String ' Calcul de la 7e heure Windows("test1.xls").Activate Range("AP8").Select For Boucle = 4 To 54 NomFichier = "test" & Boucle & ".xls)" ' Ici j'ouvrirais le fichier 'Workbooks.Open NomFichier ' Au lieu de l'activer Windows(NomFichier).Activate Range("B1").Select ActiveSheet.Range("$A$1:$DJ$10000").AutoFilter Field:=2, _ Criteria1:=">6:00:00:000", Operator:=xlAnd, Criteria2:="<7:00:00:000" ' Ici je fermerais le fichier 'ActiveWorkbook.Close Next Boucle Windows("test1.xls").Activate ActiveCell.FormulaR1C1 = "=(SUM(test4.xls!C5)+SUM(test5.xls!C5)+SUM(test6.xls!C5)+SUM(test7.xls!C5)+SUM(test8.xls!C5)+SUM(test9.xls!C5)+SUM(test10.xls!C5)+SUM(test11.xls!C5)+SUM(test12.xls!C5)+SUM(test13.xls!C5)+SUM(test14.xls!C5)+SUM(test15.xls!C5)+SUM(test16.xls!C5)+SUM(test17.xls!C5)+SUM(test18.xls!C5)+SUM(test19.xls!C5)+SUM(test20.xls!C5)+SUM(test21.xls!C5)+SUM(test22.xls!C5)+SUM(test23.xls!C5)+SUM(test24.xls!C5)+SUM(test25.xls!C5)+SUM(test26.xls!C5)+SUM(test27.xls!C5)+SUM(test28.xls!C5)+SUM(test29.xls!C5)+SUM(test30.xls!C5)+SUM(test31.xls!C5)+SUM(test32.xls!C5)+SUM(test33.xls!C5)+SUM(test34.xls!C5)+SUM(test35.xls!C5)+SUM(test36.xls!C5)+SUM(test37.xls!C5)+SUM(test38.xls!C5)+SUM(test39.xls!C5)+SUM(test40.xls!C5)+SUM(test41.xls!C5)+SUM(test42.xls!C5)+SUM(test43.xls!C5)+SUM(test44.xls!C5)+SUM(test45.xls!C5)+SUM(test46.xls!C5)+SUM(test47.xls!C5)+SUM(test48.xls!C5)+SUM(test49.xls!C5)+SUM(test50.xls!C5)+SUM(test51.xls!C5)+SUM(test52.xls!C5)+SUM(test53.xls!C5)+SUM(test54.xls!C5))/3600" End Sub Donc, il faut crée une boucle pour les heures : les conditions ">6:00:00:000" et "<7:00:00:000" peuvent être placé dans une variable ex: Sub Temporel() Dim Boucle As Integer Dim HeureDebut As Date Dim HeureFinal As Date HeureDebut = "0:00:00" HeureFinal = "1:00:00" For Boucle = 0 To 23 MsgBox Format(HeureDebut, "hh:mm:ss.000") & " -:- " & Format(HeureFinal, "hh:mm:ss.000") HeureDebut = HeureDebut + "1:00:00" HeureFinal = HeureFinal + "1:00:00" Next Boucle End Sub ensuite à l'intérieur de cette boucle placé la première boucle de la routine [ Calcul_7Hre ]. qui devrait elle inclure l'ouverture/fermeture de tes classeurs. Bien sur, je n'ai pas encore tout comprit, mais je crois qu'avec ces quelques lignes, tu devrais avancé ! @+ Lupin

Aymen · Answer

Bonjour Mr 
merci pour votre programme est vrément génial 

je l'ai testé et j'ai fé comme vous m'avez dit donc j'ai obtenu un programme comme ca :
Option Explicit


Sub Temporel()

    Dim Boucl As Integer
    Dim HeureDebut As Date
    Dim HeureFinal As Date
    Dim Boucle As Long
    Dim NomFichier As String
   
    
    HeureDebut = "0:00:00"
    HeureFinal = "1:00:00"
    
    For Boucl = 0 To 23
        MsgBox Format(HeureDebut, "hh:mm:ss:000") & " -:- " & Format(HeureFinal, hh:mm:ss:000")
        HeureDebut = HeureDebut + "1:00:00"
        HeureFinal = HeureFinal + "1:00:00"
    'j'ai voulu ici créer une boucle qui change AP du calsseur c'est à dire a chaque fois qu'une somme est faite pour chaque heure elle est stocké dans la case AP, AP1, AP2,...
Dim rangee As Long
Dim APg As String

    ' Calcul pour toutes les heures
    
    
    
    For rangee = 2 To 4
   ' Windows("test1.xls").Activate
'APg = "AP" & rangee
    
    'Range("APg").Select
    
    For Boucle = 4 To 54
        NomFichier = "C:\Users\Aymen\Desktop\data	ako	est" & Boucle & ".xls"
        ' Ici j'ouvrirais le fichier
        Workbooks.Open NomFichier
               Range("B1").Select
        ActiveSheet.Range("$A$1:$DJ$10000").AutoFilter Field:=2, _
            Criteria1:=">HeureDebut", Operator:=xlAnd, Criteria2:="<HeureFinal"
        ' Ici je fermerais le fichier
     ActiveWorkbook.Close
       Next Boucle
   ' Next rangee
    
     Windows("test1.xls").Activate
    ActiveCell.FormulaR1C1 = "=(SUM(test4.xls!C5)+SUM(test5.xls!C5)+SUM(test6.xls!C5))/3600"
      
        Next Boucl
End Sub

1er problème: c'est que une fois les classeurs test fermé, la case danlaquelle se fait la somme dans le classeur 1 affiche "REF" parceque elle ne peut pas apporter les valeurs du classeur fermé
2 ème problème : la boucle que j'ai fait pour changer les AP elle se bloque au niveau 'Range("APg").Select

Donc je vous explique un peut plus pour que vous comprenez le programme parfaitement 

a chaque fois on lit les fichier et on filtre selon chaque heure, on va obtenir des valeur dans la colone E:E, La somme des colonnes E:E des différents classeurs sera sommé est divisé par 3600 et ensuite affiché dans le classeur 1 donc pour enfin obtenir une colonne dans le classeur 1 qui contien valeur pour heure 1 , valeur pour heure 2,....
merci et bonne journée

Utilisateur anonyme · Answer

re :

Je n'ai pas encore tout regarder, car je croyais avoir le temps de structurer ton code.

entre autre, ici il y a affectation de variable :

'APg = "AP" & rangee 

Si AP est une variable :

cela devient :

'APg = AP & rangee

et aussi la ligne :

'Range("APg").Select 

devient:

'Range(APg).Select 

Comme je t'ai dit, si j'arrive à trouver du temps je regarderai plus spécifiquement
la structure de ton code.

@+
Lupin

Utilisateur anonyme · Answer

Bonjour, Le temps file à toute allure et je n'ai pas eu le temps de regarder le code. Ceci dit, je vois encore l'ambiguité au niveau de la variable [ AP ] ??? Dim AP As String For ra = 1 To 1 Windows("test1.xls").Activate Range("AP" & Boucl).Select Ici, je constate que la variable AP est défini comme une "string". Est-ce que tu as nommé une cellule avec le nom [ AP ]. Si une cellule est nommé [ AP ], ça porte a confusion que de déclaré une variable du même nom. Dim AP As String Si ce n'est pas le nom d'une cellule, mais bien le nom d'une variable, la syntaxe est : Range(AP & Boucl).Select Dons pas de guillemets pour la variable, c'est problement ce qui cause la non-réussite de la recherche. Je te cite : "c'est à dire a chaque fois qu'une somme est faite pour chaque heure elle est stocké dans la case AP, AP1, AP2,..." Ceci me porte à croire que tu as nommé les cases (cellules) au nom de AP, AP1, AP2 ... Pour adresser ces cellules, ce serait comme tu fais : Range("AP" & Boucl).Select mais la déclaration [ Dim AP As String ] crée une ambiguité. Autre point : dans ces lignes : Windows("test2.xls").Activate ActiveWorkbook.Close SaveChanges:=False Windows("test3.xls").Activate ActiveWorkbook.Close SaveChanges:=False Windows("test4.xls").Activate ActiveWorkbook.Close SaveChanges:=False peuvent être remplacé par :


Application.DisplayAlerts = False
For RA = 2 To 4
    Windows("test" & RA & ".xls").Activate
    ActiveWorkbook.Close
Next RA
Application.DisplayAlerts = True


je ne dis pas que ta méthode est mauvaise, ce n'est qu'une autre façon.

@+
Lupin

Utilisateur anonyme · Answer

Bonjour, Je n'ai pu trouver une soluce avec le filtre activé. Je te propose donc de faire une boucle sur ta plage pour effectuer ta somme plutôt qu'un filtre ! ActiveSheet.Range("$A$1:$DJ$10000").AutoFilter Field:=2, _ Criteria1:=">HeureDebut", Operator:=xlAnd, Criteria2:=" Dim HeureFinal As Date ' < ' En supposant que l'heure de début est en colonne A ' En supposant que l'heure final est en colonne E ' En supposant que l'heure comprise entre de début et final soit en colonne F ' For Each Cellule In Plage If ((Cellule.Value > HeureDebut) And (Cellule.Offset(0, 5).Value < HeureFinal)) Then Somme = Somme = Cellule.Offset(0, 6).Value End If Next Cellule End Sub ' Lupin

Utilisateur anonyme · Answer

re :

Dans la boucle :

    For Each Cellule In Plage
        If ((Cellule.Offset(0, 2).Value > HeureDebut) And (Cellule.Offset(0, 2).Value < HeureFinal)) Then
            Somme = Somme = Cellule.Offset(0, 5).Value
        End If
    Next Cellule


Il faut d'abord définir les variables :


    Dim Cellule As Range, Plage As Range, Somme As Variant


ensuite if faut instancié l'objet Plage :
 
    Set Plage = Range("A1:A10000")


Je cite : [ ... je veut filtrer sur une seule colonne (B) .., ]

donc la position devient :

Cellule.Offset(0, 1).Value 

Puisque :

Cellule.Offset(0, 0).Value fournit la valeur de [ A1 ] au premier tour dans la boucle
puisque la plage est défini de [ A1 à A1000 ] et ainsi de suite ...
Cellule.Offset(0, 1).Value fournit la valeur de [ B1 ]
Cellule.Offset(0, 2).Value fournit la valeur de [ C1 ]
Cellule.Offset(0, 3).Value fournit la valeur de [ D1 ]
Cellule.Offset(0, 4).Value fournit la valeur de [ E1 ]

je cite : [ ... c'est dans la colonne (E) je veut sommer toute la colonne (E) aprés le filtrage ... ]

d'où la ligne :

    Somme = Somme = Cellule.Offset(0, 4).Value


je cite : [ ... diviser la somme par 3600 et le résultat trouver qui est du genre 3434,3434 je voudrais qu'il soit afficher dans une colonne a part d'un autre classeur... ]


    If (Somme > 0) Then
        Somme = Somme / 3600
    End If
    Windows("test1.xls").Activate 
    Range("AP" & Boucl).Select 
    ActiveCell.Value = Somme  
    ActiveWorkbook.Close SaveChanges:=True


Lupin

Utilisateur anonyme · Answer

re :

Soit tu exécute ta routine en mode pas à pas pour valider toutes les manipulations des données,
soit tu dépose ton fichier sur ci-joint.com si celui-ci ne contient pas d'information confidentiel.

Je pourrai alors le déboguer, sans les données je ne puis tester le code que je te fournis
ce ne sont toujours que des exemples types, n'ayant pas les données pour valider, et travailler
sur des heures est l'une des choses les plus fragiles sous VBA.

Lupin

Utilisateur anonyme · Answer

re :

avec les deux liens, j'attérit sur une page qui me dit [ !!! Fichier non accessible !!! ].

Lupin

Utilisateur anonyme · Answer

re :

J'ai bien réussi à télécharger le premier test1.xls, mais pas le second.

et il n'y a aucune macro VBA dans ce fichier, les données sont là
mais ou est le code ?

Lupin

Utilisateur anonyme · Answer

re : Voilà j'ai pu télécharger le deuxième fichier. J'ai retravaillé le code en fonction de ce que j'ai compris de ce que tu tente de faire. Le code tel que je l'ai remodeler, fonctionne bien mais ce sont les données qui ne correspondent pas aux critères de recherche. Dans les fichiers test1.xls et test2.xls, les temps sont fournit selon la structure : ex: test1.xls Ligne 9989 [ 0:00:49:871 ] - Un format inconnu de Excel Ligne 9990 [ 0:01:00:902 ] - Un format inconnu de Excel on devrait lire : Ligne 9989 [ 0:00:49,871 ] -> 49 secondes , 871 millièmes de secondes Ligne 9990 [ 0:01:00,902 ] -> 1 minute , 0 seconde, 902 millièmes de secondes or les lignes : HeureDebut = "0:00:00" HeureFinal = "1:00:00" et HeureDebut = HeureDebut + "1:00:00" HeureFinal = HeureFinal + "1:00:00" initialise les critères à : HeureDebut [ 01:00:00,000 ] -> 1 heure, 0 minute, 0 seconde, 0 millième HeureFinal [ 02:00:00,000 ] -> 2 heures, 0 minute, 0 seconde, 0 millième donc la ligne de test : If ((Cellule.Offset(0, 1).Value > HeureDebut) And (Cellule.Offset(0, 1).Value < HeureFinal)) Then ne sera jamais VRAI, donc l'instruction [ Somme = Somme = Cellule.Offset(0, 4).Value ] n'est jamais exécuter. Il faut changer le format des temps de [ 00:00:00:000 ] à [ 00:00:00,000 ] et vérifier si tu recherche des temps entre 1 heure et 2 heure HeureDebut [ 01:00:00,000 ] -> 1 heure, 0 minute, 0 seconde, 0 millième HeureFinal [ 02:00:00,000 ] -> 2 heures, 0 minute, 0 seconde, 0 millième ou des temps entre 1 minute et 2 minute HeureDebut [ 00:01:00,000 ] -> 1 heure, 0 minute, 0 seconde, 0 millième HeureFinal [ 00:02:00,000 ] -> 2 heures, 0 minute, 0 seconde, 0 millième En plaçant tous les fichiers dans le même dossier, voici le code débugger selon ce que j'ai compris ! Option Explicit ' Sub Temporel() Dim Boucl As Integer Dim HeureDebut As Date Dim HeureFinal As Date Dim Boucle As Long Dim NomFichier As String Dim Plage As Range, Cellule As Range Dim Somme As Variant HeureDebut = "0:00:00" HeureFinal = "1:00:00" For Boucl = 1 To 2 HeureDebut = HeureDebut + "1:00:00" HeureFinal = HeureFinal + "1:00:00" NomFichier = ActiveWorkbook.Path & "\Globale" & Boucl & ".xls" Workbooks.Open NomFichier For Boucle = 1 To 2 'a titre d'exemple j'ai prix de 1 à 2 NomFichier = ActiveWorkbook.Path & "\Test" & Boucle & ".xls" Workbooks.Open NomFichier Set Plage = Range("A1:A10000") For Each Cellule In Plage If ((Cellule.Offset(0, 1).Value > HeureDebut) And (Cellule.Offset(0, 1).Value < HeureFinal)) Then Somme = Somme = Cellule.Offset(0, 4).Value End If Next Cellule ActiveWorkbook.Close If (Somme > 0) Then Somme = Somme / 3600 Else Somme = 0 End If Windows("Globale1.xls").Activate Range("AP" & Boucle).Select ActiveCell.Value = Somme Next Boucle ActiveWorkbook.Close SaveChanges:=True Next Boucl End Sub ' Autre point, il y a vraiment plusieurs fichiers globales ? ->->-> For Boucl = 1 To 2 cette boucle me semble superflu ! le code devrait être : Sub Temporel2() Dim Boucl As Integer Dim HeureDebut As Date Dim HeureFinal As Date Dim Boucle As Long Dim NomFichier As String Dim Plage As Range, Cellule As Range Dim Somme As Variant HeureDebut = "0:00:00" HeureFinal = "1:00:00" HeureDebut = HeureDebut + "1:00:00" HeureFinal = HeureFinal + "1:00:00" NomFichier = ActiveWorkbook.Path & "\Globale.xls" Workbooks.Open NomFichier For Boucle = 1 To 2 'a titre d'exemple j'ai prix de 1 à 2 NomFichier = ActiveWorkbook.Path & "\Test" & Boucle & ".xls" Workbooks.Open NomFichier Set Plage = Range("A1:A10000") For Each Cellule In Plage If ((Cellule.Offset(0, 1).Value > HeureDebut) And (Cellule.Offset(0, 1).Value < HeureFinal)) Then Somme = Somme = Cellule.Offset(0, 4).Value End If Next Cellule ActiveWorkbook.Close If (Somme > 0) Then Somme = Somme / 3600 Else Somme = 0 End If Windows("Globale1.xls").Activate Range("AP" & Boucle).Select ActiveCell.Value = Somme Next Boucle ActiveWorkbook.Close SaveChanges:=True End Sub ' Alors ceci devrait débroussailler le terrain quelque peu ! Lupin

Aymen · Answer

voici le code que je utilise et qui donne tjs somme =0
qu'est ce qu'il faut faire SVP?? moi j'aimerai bien travailler en heure pas en minutes
Option Explicit
Sub Temporel2()

    Dim Boucl As Integer
    Dim HeureDebut As Date
    Dim HeureFinal As Date
    Dim Boucle As Long
    Dim NomFichier As String
    
    Dim Plage As Range, Cellule As Range
    Dim Somme As Variant
    
    HeureDebut = "0:00:00"
    HeureFinal = "1:00:00"
    For Boucl = 1 To 2 'cette boucle permet de passer dune heure a une autre
      
    HeureDebut = HeureDebut + "1:00:00"
    HeureFinal = HeureFinal + "1:00:00"
    
    NomFichier = ActiveWorkbook.Path & "\fichglob.xlsx"
    Workbooks.Open NomFichier
    
    For Boucle = 1 To 2 'a titre d'exemple j'ai prix de 1 à 2
        NomFichier = ActiveWorkbook.Path & "\Test" & Boucle & ".xls"
        Workbooks.Open NomFichier
    
        Set Plage = Range("A1:A10")
        For Each Cellule In Plage
            If ((Cellule.Offset(0, 1).Value > HeureDebut) And (Cellule.Offset(0, 1).Value < HeureFinal)) Then
                Somme = Somme = Cellule.Offset(0, 4).Value
            End If
        Next Cellule
        ActiveWorkbook.Close
        If (Somme > 0) Then
            Somme = Somme / 3600
        Else
            Somme = 0
        End If
        Windows("fichglob.xlsx").Activate
        Range("AC" & Boucle).Select
        ActiveCell.Value = Somme
    Next Boucle
    ActiveWorkbook.Close SaveChanges:=True
    Next Boucl
End Sub

Utilisateur anonyme · Answer

re :

Un fichier globale, donc le code de la routine Temporel2 de mon dernier message est le bon.

Et ça ne fonctionne pas à cause du format du temps comme je t'ai expliqué dans mon précédent message :

1) Le format non reconnu d'Excel
Il faut changer le format des temps de [ 00:00:00:000 ] à [ 00:00:00,000 ] et vérifier si tu recherche 
des temps entre 1 heure et 2 heure 
HeureDebut [ 01:00:00,000 ] -> 1 heure, 0 minute, 0 seconde, 0 millième 
HeureFinal [ 02:00:00,000 ] -> 2 heures, 0 minute, 0 seconde, 0 millième 

ou des temps entre 1 minute et 2 minute 
HeureDebut [ 00:01:00,000 ] -> 1 heure, 0 minute, 0 seconde, 0 millième 
HeureFinal [ 00:02:00,000 ] -> 2 heures, 0 minute, 0 seconde, 0 millième 
 
2) Des heures ou des minutes ?
Alors actuellement, les variables [ HeureDebut et  HeureFinal ] contiennent des valeurs
de l'ordre des heures et tes données sont de l"ordre des minutes.

Lupin