Sujet Précédent Sujet Suivant

A propos VBA Excel

Fermé
aymenayari Messages postés 1 Date d'inscription mercredi 21 mai 2008 Statut Membre Dernière intervention 21 mai 2008 - 21 mai 2008 à 19:34
 Aymen - 26 juin 2008 à 11:56
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
A voir également:

19 réponses

Réponse 1 / 19
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
23 mai 2008 à 09:36
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.
0
Réponse 2 / 19
Utilisateur anonyme
23 mai 2008 à 14:10
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
0
Aymen
23 mai 2008 à 16:02
Merci je vé l'essayer et je t'envéré le résultat le plus tot et encore un grand merci pour votre aide
je suis débutant dans VBA excel si vous pouvez me guidé dans les étapes qui consiste à passer de excel pour créer ce code
j'utilise Excel 2007
pour moi je fé comme ca:
dans la feuille excel sur laquelle je travaille j'utilise le bouton qui bascule vers l'interface VB
il y a a gauche la stucture sheet1, sheet2,... et this workbook
j'appui dessu deux fois une feuille VB s'ouvre pour m'indiquer ce code
Private Sub Workbook_Open()

End Sub
est ce que j'introduit votre code dans cette partie ou comment je fé?
merci
0
Réponse 3 / 19
Utilisateur anonyme
23 mai 2008 à 17:22
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
0
Réponse 4 / 19
Aymen
24 mai 2008 à 13:23
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
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 19
Utilisateur anonyme
26 mai 2008 à 13:38
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
0
aymen
27 mai 2008 à 13:34
Salut
merci de m'avoir répondu tout le temps j'ai reussi a faire un script qui permet de lire les feuille contenu dans un meme calsseur et de faire le calcul que je veut
mais le problème qui reste c'est mes fichiers excel sont séparés et c'est moi qui fé le copier coller pour les mettre dans un meme classeur ce qui est génant donc je voudrai bien automatisé les chose et applée les fichiers direct et eeffectué dessu les opérations que je veut et afficher les reultat dans la première feuille
voici le code que j'utilise
Sub trafcalc()
'
' trafcalc Macro
'

'
'calcul dans la feuille 1 pour les valeurs inferieurs et égale à une heure

ActiveSheet.Range("$A$6:$AN$10000").AutoFilter Field:=2, Criteria1:= _
"<0:01:00:004"
Range("AP2").Select
ActiveCell.FormulaR1C1 = "=SUM(C[-37])/3600"


'calcul dans la feuille 1 pour la deuxième heure Combinaison entre la feuille 1,, 2 et 3


Sheets("test1").Select

ActiveSheet.Range("$A$1:$AN$10000").AutoFilter Field:=2, Criteria1:= _
">0:01:00:004", Operator:=xlAnd, Criteria2:="<0:02:00:000"

Sheets("Feuil1").Select

ActiveSheet.Range("$A$1:$AN$10000").AutoFilter Field:=2, Criteria1:= _
">0:01:00:004", Operator:=xlAnd, Criteria2:="<0:02:00:000"
Sheets("Feuil2").Select
ActiveSheet.Range("$A$1:$AN$10000").AutoFilter Field:=2, Criteria1:= _
">0:01:00:004", Operator:=xlAnd, Criteria2:="<0:02:00:000"

Sheets("test1").Select
Range("AP3").Select
ActiveCell.FormulaR1C1 = "=(SUM(Feuil2!C[-37])+SUM(Feuil1!C[-37])+SUM(test1!C[-37]))/3600"
'calcul dans la feuille 1 pour la Troisième heure Combinaison entre la feuille 2,,3,,4

Sheets("Feuil2").Select
ActiveSheet.Range("$A$1:$AN$10000").AutoFilter Field:=2, Criteria1:= _
">0:02:00:000", Operator:=xlAnd, Criteria2:="<0:03:00:000"
Sheets("Feuil3").Select
ActiveSheet.Range("$A$1:$AN$10000").AutoFilter Field:=2, Criteria1:= _
">0:02:00:000", Operator:=xlAnd, Criteria2:="<0:03:00:000"
Sheets("Feuil4").Select
ActiveSheet.Range("$A$1:$AN$10000").AutoFilter Field:=2, Criteria1:= _
">0:02:00:000", Operator:=xlAnd, Criteria2:="<0:03:00:000"

Sheets("test1").Select
Range("AP4").Select
ActiveCell.FormulaR1C1 = "=(SUM(Feuil2!C[-37])+SUM(Feuil3!C[-37])+SUM(Feuil4!C[-37]))/3600"
'calcul dans la feuille pour la quatrième heure Combinaison entre la feuille 2,,3,,4

Sheets("Feuil3").Select

ActiveSheet.Range("$A$1:$AN$10000").AutoFilter Field:=2, Criteria1:= _
">0:03:00:000", Operator:=xlAnd, Criteria2:="<0:04:00:000"


Sheets("Feuil4").Select

ActiveSheet.Range("$A$1:$AN$10000").AutoFilter Field:=2, Criteria1:= _
">0:03:00:000", Operator:=xlAnd, Criteria2:="<0:04:00:000"

Sheets("test1").Select
Range("AP5").Select
ActiveCell.FormulaR1C1 = "=(SUM(Feuil3!C[-37])+SUM(Feuil4!C[-37]))/3600"
End Sub

mille merci de m'aider
0
Réponse 6 / 19
Utilisateur anonyme
27 mai 2008 à 14:59
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
0
aymen
27 mai 2008 à 15:44
salut
bon j'ai testé le programme il marche mais j'ai du enlevé ces deux lignes dans la partie Sub ImporteClasseurs()

cte_Cumul_Global
Reponse = EnteteColonne(ListeFichiers(0))

parceque ils ne sont pas defini

une fois exécuté il me donne la main pour choisir le dossier dans lequel il y a les fichiers, il crée un fichier nommé fichierglobal mais qui est vide et il me dit qu'il a pas trouvé auncun fichier xls dans le repertoire sepécifié

Que faire ??
MErci
0
aymen
27 mai 2008 à 15:54
salut
Merci pour le programme
je les tester il y a dans la sub (Sub ImporteClasseurs())
pour que ca fonctionne j'ai du supprimer ces deux lignes
cte_Cumul_Global
Reponse = EnteteColonne(ListeFichiers(0))

parceque ils ne sont pas defini

l'exécution aprés me donne la main pour choisir le dossier dans lequels il y a les fichiers a traiter
mais aprés il crée un nouveau classeur appelé Fichierglobal mais qui est vide et me dit que
Aucun fichier n'a été trouvé"
"dans le répertoire cible
"Vérifié et corriger la situation
que faire ???
Merci
0
Réponse 7 / 19
Utilisateur anonyme
27 mai 2008 à 17:08
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
0
Aymen
29 mai 2008 à 16:06
Bonjour
Mille Merci pour le programme que vous am'avez donné il foctionne trés bien
mais je voudrais si possible ne pas ouvrir mes fichiers Excels parceque j'ai essayer de les ouvrir il prenne trop de temps puisque leurs taille est trop grande Donc il vaut mieux les lire sans les ouvrir pour
aprés les avoir lu automatiquement toute la totalité des fichiers je vé appliqué dessu le calcul suivant qui consiste a lire chaque fichier faire un filtre sur les durée de connection pour chaque heure et faire un calcul qui sera affiché dans les AP1...APN N est le (nombre de fichier) du classeur Test1
dans le programme ci dessous j'ai mis la totalité des fichiers pour la raison que je sais pas ou fini chaque heure de connection et dans quel fichier voici un exemple du format que je traite
0:00:01:338
0:00:01:396
0:00:01:506
0:00:01:555
0:00:01:599
0:00:01:760
0:00:01:966
0:00:02:033
0:00:02:138

puisque je maitrise pas trop le VBA j'ai pas su faire une boucle pour faire en meme temps le filtrage et le calcul
S'il vous si vous pouvez m'aider comme d'habitude et vraiment je sais plus comment vous remercié
mon mail c'est aymen.ayari@gmail.com si vous voulez me contacter directement


le programme que j'ai fé est le suivant



Sub calcul()
'
' calcul Macro
'

'

'calcul pour la premiere heure

ActiveSheet.Range("$A$6:$AN$10000").AutoFilter Field:=2, Criteria1:= _
"<1:00:00:000", Operator:=xlAnd
Range("AP2").Select
ActiveCell.FormulaR1C1 = "=(SUM(C[-37]))/3600"

'calcul pour la deuxième heure

Windows("test1.xls").Activate
Range("AP3").Select

Windows("test2.xls").Activate
Range("B1").Select
ActiveSheet.Range("$A$1:$DJ$10000").AutoFilter Field:=2, Criteria1:= _
">1:00:00:000", Operator:=xlAnd, Criteria2:="<2:00:00:000"

Windows("test1.xls").Activate
ActiveCell.FormulaR1C1 = "=(SUM(test1.xls!C5)+SUM(test2.xls!C5))/3600"

'calcul de troisième heure

Windows("test1.xls").Activate
Range("AP4").Select
Windows("test2.xls").Activate
Range("B1").Select
ActiveSheet.Range("$A$1:$DJ$10000").AutoFilter Field:=2, Criteria1:= _
">2:00:00:000", Operator:=xlAnd, Criteria2:="<3:00:00:000"
Windows("test3.xls").Activate
Range("B1").Select
ActiveSheet.Range("$A$1:$DJ$10000").AutoFilter Field:=2, Criteria1:= _
">2:00:00:000", Operator:=xlAnd, Criteria2:="<3:00:00:000"

Windows("test1.xls").Activate
ActiveCell.FormulaR1C1 = "=(SUM(test2.xls!C5)+SUM(test3.xls!C5))/3600"

'calcul de la quatrième heure
Windows("test1.xls").Activate
Range("AP5").Select
Windows("test3.xls").Activate
Range("B1").Select
ActiveSheet.Range("$A$1:$DJ$10000").AutoFilter Field:=2, Criteria1:= _
">3:00:00:000", Operator:=xlAnd, Criteria2:="<4:00:00:000"
Windows("test4.xls").Activate
Range("B1").Select
ActiveSheet.Range("$A$1:$DJ$10000").AutoFilter Field:=2, Criteria1:= _
">3:00:00:000", Operator:=xlAnd, Criteria2:="<4:00:00:000"

Windows("test1.xls").Activate
ActiveCell.FormulaR1C1 = "=(SUM(test3.xls!C5)+SUM(test4.xls!C5))/3600"

'calcul de la 5 heure
Windows("test1.xls").Activate
Range("AP6").Select
Windows("test3.xls").Activate
Range("B1").Select
ActiveSheet.Range("$A$1:$DJ$10000").AutoFilter Field:=2, Criteria1:= _
">4:00:00:000", Operator:=xlAnd, Criteria2:="<5:00:00:000"
Windows("test4.xls").Activate
Range("B1").Select
ActiveSheet.Range("$A$1:$DJ$10000").AutoFilter Field:=2, Criteria1:= _
">4:00:00:000", Operator:=xlAnd, Criteria2:="<5:00:00:000"

Windows("test1.xls").Activate
ActiveCell.FormulaR1C1 = "=(SUM(test3.xls!C5)+SUM(test4.xls!C5))/3600"
'calcul de la 6me heure
Windows("test1.xls").Activate
Range("AP7").Select
Windows("test3.xls").Activate
Range("B1").Select
ActiveSheet.Range("$A$1:$DJ$10000").AutoFilter Field:=2, Criteria1:= _
">5:00:00:000", Operator:=xlAnd, Criteria2:="<6:00:00:000"
Windows("test4.xls").Activate
Range("B1").Select
ActiveSheet.Range("$A$1:$DJ$10000").AutoFilter Field:=2, Criteria1:= _
">5:00:00:000", Operator:=xlAnd, Criteria2:="<6:00:00:000"

Windows("test1.xls").Activate
ActiveCell.FormulaR1C1 = "=(SUM(test3.xls!C5)+SUM(test4.xls!C5))/3600"
'calcul de la 7me heure
Windows("test1.xls").Activate
Range("AP8").Select
Windows("test4.xls").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"
Windows("test5.xls").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"

Windows("test6.xls").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"
Windows("test7.xls").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"
Windows("test8.xls").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"
Windows("test9.xls").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"
Windows("test10.xls").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"
Windows("test11.xls").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"
Windows("test12.xls").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"
Windows("test13.xls").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"
Windows("test14.xls").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"
Windows("test15.xls").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"
Windows("test16.xls").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"

Windows("test17.xls").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"
Windows("test18.xls").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"
Windows("test19.xls").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"
Windows("test20.xls").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"
Windows("test21.xls").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"
Windows("test22.xls").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"
Windows("test23.xls").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"
Windows("test24.xls").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"
Windows("test25.xls").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"
Windows("test26.xls").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"
Windows("test27.xls").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"
Windows("test28.xls").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"
Windows("test29.xls").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"
Windows("test30.xls").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"
Windows("test31.xls").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"
Windows("test32.xls").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"
Windows("test33.xls").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"
Windows("test34.xls").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"
Windows("test35.xls").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"
Windows("test36.xls").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"
Windows("test37.xls").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"
Windows("test38.xls").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"
Windows("test39.xls").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"
Windows("test40.xls").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"
Windows("test41.xls").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"
Windows("test42.xls").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"
Windows("test43.xls").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"
Windows("test44.xls").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"
Windows("test45.xls").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"
Windows("test46.xls").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"
Windows("test47.xls").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"
Windows("test48.xls").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"
Windows("test49.xls").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"
Windows("test50.xls").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"
Windows("test51.xls").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"
Windows("test52.xls").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"
Windows("test53.xls").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"
Windows("test54.xls").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"



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"


'calcul de la 8me heure

'calcul de la 9me heure

'calcul de la 10e heure

'calcul de la 11me heure
'calcul de la 12me heure
'calcul de la 13ème heure
'calcul de la 14ème heure
'calcul de la 15me heure
'calcul de la 16me heure
'calcul de la 17me heure
'calcul de la 18me heure
'calcul de la 19me heure
'calcul de la 20me heure
'calcul de la 21me heure
'calcul de la 22me heure
'calcul de la 23me heure
'calcul de la 24me heure






















End Sub
0
Réponse 8 / 19
Utilisateur anonyme
2 juin 2008 à 19:46
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(tes­t13.xls!C5)+SUM(test14.xls!C5)+SUM(test15.xls!C5)+SUM(test16.xls!C5)+SUM(test17.xls!C5)+SU­M(test18.xls!C5)+SUM(test19.xls!C5)+SUM(test20.xls!C5)+SUM(test21.xls!C5)+SUM(test22.xls!C­5)+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(te­st32.xls!C5)+SUM(test33.xls!C5)+SUM(test34.xls!C5)+SUM(test35.xls!C5)+SUM(test36.xls!C5)+S­UM(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(t­est51.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
0
aymen
5 juin 2008 à 15:30
bonjour
encore merci pour votre programme,
j'ai fait plusieurs modifications pour arriver a un certain stade j'ai reussi a faire la somme des colones pour chaque fichier mais j'obtien tjs la meme valeur dans toutes les cases AP je sais le problème reside dans le filtre ou autre chose entouka je suis vraiment bloqué

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"
'a titre d'exemple la boucle est de 1 à 2
For Boucl = 1 To 2
MsgBox Format(HeureDebut, "hh:mm:ss:000") & " -:- " & Format(HeureFinal, "hh:mm:ss:000")
HeureDebut = HeureDebut + "1:00:00"
HeureFinal = HeureFinal + "1:00:00"

Dim ra As Integer

Dim AP As String

'j'ouvre le fichier test1,

Workbooks.Open "C:\Users\Aymen\Desktop\data\tako\test1.xls"

For Boucle = 2 To 4

NomFichier = "C:\Users\Aymen\Desktop\data\tako\test" & 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"
Next Boucle

'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,...
la boucle ra est juste pour pouvoir séparer la première boucle et pouvoir enregistré a chaque fois le fichier qui va stocké les valeurs
For ra = 1 To 1

Windows("test1.xls").Activate
Range("AP" & Boucl).Select
ActiveCell.FormulaR1C1 = "=(SUM(test2.xls!C5)+SUM(test3.xls!C5))/3600"
Range("AO" & Boucl).Select
ActiveCell.FormulaR1C1 = "=RC[1]"
ActiveWorkbook.Close SaveChanges:=True
Next ra

' Ici je ferme les fichiers pour qu'au moment de l'exécution de la deuxième Boucl de temps le fichier souvre normalement et me fait un debogage
Windows("test2.xls").Activate
ActiveWorkbook.Close SaveChanges:=False

Windows("test3.xls").Activate
ActiveWorkbook.Close SaveChanges:=False
Windows("test4.xls").Activate
ActiveWorkbook.Close SaveChanges:=False

Next Boucl


End Sub

Ce programme me permet d'ouvrir les fichiers de faire le calcul de stocké dans le fichié test1 chaque veleur pour chaque heure est stocké dans une case AP, mais mon problème c'est que cé toujours la meme valeur dans toute les cases malgré quelle doit changé puisque la boucl d'heure change "donc le filtre des valeurs change et donne d'autre plage de valeurs

S'il vous plait aidez moi et merci d'avance
0
Réponse 9 / 19
Aymen
3 juin 2008 à 09:25
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\tako\test" & 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
0
Réponse 10 / 19
Utilisateur anonyme
5 juin 2008 à 16:28
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
0
Aymen
11 juin 2008 à 15:09
Bonjour j'espère que vous alez bien
bon je suis toujours bloqué dans ce programme j'ai apris beaucoup de chose sur le VBA mais apprament c'est pas suffisant:
en faisant tourner le programme qui contien le fitrage il s'est avéré que je récupère tout le temps le meme résultat meme si on change la plage du filtrage et ce ci est du au fait que

Windows("classeur1.xls").Activate
Range("AP" & Boucl).Select 'pour changer l'emplacement de sauvgarde des valeurs suivant le filtage
ActiveCell.FormulaR1C1 = "=(SUM(test2.xls!C5)+SUM(test3.xls!C5))/3600"
c'est a dire ici on somme toujours la colonne E:E et ceci ne tien pas compte du filtrage, je suis bloqué ici j'ai pa su comment faire pour tenir compte du filtrage qu'on fait a chaque heure pour l'ensemble des fichiers
Le code utilisé est celui ci :

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 ra As Integer
Dim AP As String

HeureDebut = "0:00:00"
HeureFinal = "1:00:00"
'Workbooks.Open "C:\Users\Aymen\Desktop\data\tako\test1.xls"
For Boucl = 1 To 2
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,...

Workbooks.Open "C:\Users\Aymen\Desktop\data\tako\test1.xls"

For Boucle = 2 To 4 'a titre d'exemple j'ai prix de 2 à 4

NomFichier = "C:\Users\Aymen\Desktop\data\tako\test" & 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"

Next Boucle

For ra = 1 To 1
Windows("test1.xls").Activate
Range("AP" & Boucl).Select
ActiveCell.FormulaR1C1 = "=(SUM(test2.xls!C5)+SUM(test3.xls!C5))/3600"
ActiveWorkbook.Close SaveChanges:=True


Windows("test2.xls").Activate
ActiveWorkbook.Close SaveChanges:=False

Windows("test3.xls").Activate
ActiveWorkbook.Close SaveChanges:=False
Windows("test4.xls").Activate
ActiveWorkbook.Close SaveChanges:=False

Next ra

Next Boucl


End Sub



S'il vous plait j'espère que vous avez une solution, désolé mais j'ai pas d'autre solution que d'avoir recours a votre aide



Merci
0
Réponse 11 / 19
Utilisateur anonyme
12 juin 2008 à 13:36
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 
</codes>

peuvent être remplacé par :
<code>
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
0
Aymen
12 juin 2008 à 14:35
Merci de me conçacrer un peut de temps je sais que le temps c'est de l'or
j'ai tenu compte de la variable AP elle fonctionne correctement j'ai enlevé la declaration Dim AP As string

ca marche normalement,
pour moi le problème réside dans le filtrage c'est a dire le fitrage se fait pour la colonne contenant les valeurs 1:00:00:000 ...
c'est à dire une fois que j'ai fait le filtrage selon l'heure sur toute la colonne comme ecrit dans le code je fait la somme entre les valeurs filtré de chaque fichier, mais le problème c'est la somme se fait sur toute la colonne tout le temps malgré que le filtre est en place l'instruction que j'ai ce dessous me somme toute la colonne malgré que les valeurs sont filtrés,
je sais plus qu'est ce que je dois faire ??


For Boucle = 2 To 4 'a titre d'exemple j'ai prix de 2 à 4

NomFichier = "C:\Users\Aymen\Desktop\data\tako\test" & 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"

Next Boucle

For ra = 1 To 1
Windows("test1.xls").Activate
Range("AP" & Boucl).Select
ActiveCell.FormulaR1C1 = "=(SUM(test2.xls!C5)+SUM(test3.xls!C5))/3600" ' somme des colonnes E:E pour chaque fichier aprés filtrage
ActiveWorkbook.Close SaveChanges:=True
0
Réponse 12 / 19
Utilisateur anonyme
16 juin 2008 à 14:30
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:="<HeureFinal"

ex type : 
Sub Calcul()


    Dim Plage As Range, Cellule As Range
    Dim Somme As Date

    Set Plage = Range("A1:A10000")

    Dim HeureDebut As Date ' >
    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
0
Aymen
18 juin 2008 à 12:41
Bonjour MR
merci pour la solution
je l'ai utilisé mais ca marche pas comme je veux et j'ai pas pu la modifier puisque je conais pas trés bien le VBA

For Boucle = 1 To 2 'a titre d'exemple j'ai prix de 1 à 2
NomFichier = "C:\Users\Aymen\Desktop\data\tako\test" & Boucle & ".xls"
' Ici j'ouvrirais le fichier
Workbooks.Open NomFichier

Next 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

donc le filtre se fait trés bien puisque je veut filtrer sur une seule colonne (B) qui contien des donnée du type 0:00:00:000 c'est pourquoi j'ai mis ((Cellule.Offset(0, 2).Value deux fois

la somme que je veut faire aprés le filtre c'est dans la colonne (E) je veut sommer toute la colonne (E) aprés le filtrage et 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 " comment faire ??
Merci de m'aider
0
Réponse 13 / 19
Utilisateur anonyme
18 juin 2008 à 13:08
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
0
Aymen
18 juin 2008 à 13:43
Merci votre réponse rapide j'ai bien apricié votre geste
le programme que j'utilise c'est le suivant j'ai implémenté votre code
pour obtenir le prog suivant
Au niveau de la somme j'obtien toujours Vide je sais qu'est ce qui se passe ???
S'il vous plait j'arrive pas avancer te ca commence a me stréssé :)
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

Set Plage = Range("A1:A10000")

HeureDebut = "0:00:00"
HeureFinal = "1:00:00"
'Workbooks.Open "C:\Users\Aymen\Desktop\data\tako\test1.xls"
For Boucl = 1 To 2
HeureDebut = HeureDebut + "1:00:00"
HeureFinal = HeureFinal + "1:00:00"

Workbooks.Open "C:\Users\Aymen\Desktop\data\tako\fichglob.xlsx"

For Boucle = 1 To 2 'a titre d'exemple j'ai prix de 1 à 2

NomFichier = "C:\Users\Aymen\Desktop\data\tako\test" & Boucle & ".xls"
' Ici j'ouvrirais le fichier
Workbooks.Open NomFichier

Next Boucle

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

If (Somme > 0) Then
Somme = Somme / 3600
End If
Windows("test1.xls").Activate
Range("AP" & Boucl).Select
ActiveCell.Value = Somme
ActiveWorkbook.Close SaveChanges:=True


Windows("test1.xls").Activate
ActiveWorkbook.Close SaveChanges:=False
Windows("test2.xls").Activate
ActiveWorkbook.Close SaveChanges:=False


Next Boucl


End Sub
0
Réponse 14 / 19
Utilisateur anonyme
18 juin 2008 à 14:14
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
0
Aymen
18 juin 2008 à 15:01
Salut
http://www.cijoint.fr/cjlink.php?file=cj200806/cijvPfcJzx.xls.
voici le lien du fichier sur lequel je travaille c'est le fichier test1 j'ai boucoup d'autre fichiers qui sont la suite de ce fichier
voici le fichier test2 "http://www.cijoint.fr/cjlink.php?file=cj200806/cij76hgUJb.xls. " complémentaire a test1
j'espère que vous me donnerai une solution
avec un grand merci
0
Aymen
18 juin 2008 à 15:51
voici le deuxième lien pour le deuxième fichier test2.xls
http://www.cijoint.fr/cjlink.php?file=cj200806/cijYzxEqYp.xls.
0
Réponse 15 / 19
Utilisateur anonyme
18 juin 2008 à 15:37
re :

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

Lupin
0
Aymen
18 juin 2008 à 15:44
voici le lien
http://www.cijoint.fr/cjlink.php?file=cj200806/cijy01dIBh.xls
normalement j'ai verifier qu'il marche
merci
0
Réponse 16 / 19
Utilisateur anonyme
18 juin 2008 à 16:59
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
0
Aymen
18 juin 2008 à 17:07
je vais essayer de vous renvoyer le deuxième fichiers
entouka pour le code je le met dans une autre fichiers pour juste que je puisse exécuter cé tout
a chaque fois que j'enregistre et j'ouvre il me dit qu'il n y a pas de macro dans ce fichier donc j'ouvre un nouveau classeur
je crée un module dans lequel je copie le code suivant:
ensuite j'exécute
le lien du deuxième fichier: http://www.cijoint.fr/cjlink.php?file=cj200806/cijYzxEqYp.xls
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

Set Plage = Range("A1:A10000")

HeureDebut = "0:00:00"
HeureFinal = "1:00:00"
'Workbooks.Open "C:\Users\Aymen\Desktop\data\tako\test1.xls"
For Boucl = 1 To 2
HeureDebut = HeureDebut + "1:00:00"
HeureFinal = HeureFinal + "1:00:00"

Workbooks.Open "C:\Users\Aymen\Desktop\data\tako\fichglob.xlsx"

For Boucle = 1 To 2 'a titre d'exemple j'ai prix de 1 à 2

NomFichier = "C:\Users\Aymen\Desktop\data\tako\test" & Boucle & ".xls"
' Ici j'ouvrirais le fichier
Workbooks.Open NomFichier

Next Boucle

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

If (Somme > 0) Then
Somme = Somme / 3600
End If
Windows("fichglob.xlsx").Activate
Range("AP" & Boucl).Select
ActiveCell.Value = Somme
ActiveWorkbook.Close SaveChanges:=True


Windows("test1.xls").Activate
ActiveWorkbook.Close SaveChanges:=False
Windows("test2.xls").Activate
ActiveWorkbook.Close SaveChanges:=False


Next Boucl


End Sub
0
Réponse 17 / 19
Utilisateur anonyme
18 juin 2008 à 19:41
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
0
Aymen
18 juin 2008 à 20:34
je sais pas quoi vous dire que merci merci beaucoup d'avoir donné beaucoup de votre temps
entouka j'ai testé le code il marche
mais :) pour le fichier globale je n'ai qu'un seule fichier dans lequel je veut stocké toute les somme pour les fichiers en filtrant pour chaque heure
cadire entre 0et 1 heure somme 1
1 et 2 heure somme 2 chacune dans une case AP1 AP2 ...
autre probleme la somme est toujours zero
je sais pk? ca veut pas marché
bonne soirée et merci encore
0
Réponse 18 / 19
Aymen
18 juin 2008 à 20:50
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
0
Réponse 19 / 19
Utilisateur anonyme
18 juin 2008 à 20:53
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
0
aymen
18 juin 2008 à 23:46
merci pour votre réponse
j'ai pas su comment changer le format de l'heure??
j'ai essayer j'ai pas su si il faut le changé sur fichier lui meme ou dans le programme
Svp aider moi j'aimerai bien que ce programme fonctionne
le format des heures et en minutes mais moi dans la version des fichiers finaux je vais utiliser des heures d'ou la taille des fichiers sera plus grandes
SVP vous avez les fichiers essayer de changé l'heure et me dire comment faire essayer s'il vous plait de le tester avec le nouveau format d'heure
merci
0
Aymen
26 juin 2008 à 11:56
Bonjour j'espère que vous aller bien
ces jours jétais un peut deborder par le travail
S'il vous plait j'ai une petite question concernant cette partie du code
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("A" & Boucle).Select
ActiveCell.Value = Somme
j'ai verifier avec le mode pas à pas j'ai constater que la vriable somme ne recoit pas la valeur de cellule.offset malgré que celle ci li la valuer se trouvant dans la case voulu
j'ai pas compris qu'est ce qui se passe ? moi je voudrai bien récuprer la somme de toutes les valeurs
merci de m'aider
bonne journée
0

Discussions similaires

Excel VBA : Récupérer la valeur d'une cellule
la pioche -
mikebzh -

3 réponses