A propos VBA Excel

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 
</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


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:="<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

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

A propos VBA Excel

19 réponses

Newsletters