Sommer des résultats provenant de différents fichiers

**julsd24** · 24/08/2015, 15h14

Bonjour à tous,

C'est mon premier post sur ce forum que je consulte régulièrement. Je débute en VB.
J'espère ouvrir la discussion au bon endroit.

Voici mon problème :
Tous les jours j'enregistre un fichier excel provenant d'une extraction faite sur un logiciel interne. Le nom de ces fichiers est la date du jour (ex: 20150815)
J'aimerais faire la somme d'une colonne de chacun des fichiers déterminé par une plage donnée (de tel date à tel date).
Quelqu'un a-t-il un début de solution?

Merci par avance.

**Kimy_Ire** · 24/08/2015, 15h26

Bonjour julsd24,

Ce que tu demandes est relativement simple.
Si tous les fichiers que tu télécharges ont le même formalisme (nom, colonne à sommer, etc...) et que le fichier origine contient les dates de début et de fin, il ne devrait y avoir aucun problème. Ils doivent se trouver dans un répertoire commun également.
Voici quelque chose que j'ai très rapidement réadapté :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
Option Explicit
 
Sub test()
 
Dim myPath As String, myFile As String, myPassword As String
Dim maFeuil As Worksheet
 
With Workbooks("classeur.xlsx").Worksheets("Feuil1")
    myPath = .Range("K10")
    myFile = Dir(myPath & "\*.*")
 
    'myPassword = .Range("K11")
End With
 
Do While myFile <> ""
    Call ClasseurOuvert(myPath & "\" & myFile)
 
    With Workbooks(myFile)
        If FeuilleExiste("Feuil1") Then
            Set maFeuil = .Worksheets("Echéancier ")
            Call ma_fonction(maFeuil)
 
        Else
            MsgBox "Le classeur " & myFile & " ne présente pas d'onglets ""Feuil1""."
        End If
 
        .Close True
    End With
 
    myFile = Dir()
Loop
 
End Sub
 
Function ClasseurOuvert(NomFich)
On Error Resume Next
    Workbooks(NomFich).Activate
    If Err <> 0 Then Workbooks.Open Filename:=NomFich
On Error GoTo 0
End Function
 
 
Function FeuilleExiste(NomFeuille) As Boolean
Dim f As Object
 
On Error Resume Next
Set f = Sheets(NomFeuille)
 
If Err = 0 Then FeuilleExiste = True
Set f = Nothing
End Function
 
Function ma_fonction(oWksh As Worksheet)
With oWksh
    'fait quelque chose avec la feuille passée en paramètre
End With
End Function

Mais sans d'avantage de fonctionnel, il va m'être difficile de faire d'avantage.

Voila. N'hésite pas à revenir vers moi !

Cordialement,
Kimy

EDIT : ici, il n'y a pas de vérification des noms, c'est juste un exemple pour démarrer.

**julsd24** · 24/08/2015, 17h41

Bonjour Kimy,

Merci pour cette réponse rapide.
Je joins 5 fichiers types. C'est fichier avec pour nom la date vont du 1/01/15 au 31/12/15 et cela pour chaque année.
Je veux sommer les colonnes S seulement si la colonne AA=O pour les dates que je sélectionnerais par exemple du 17/08/15 au 21/08/15.

**Kimy_Ire** · 24/08/2015, 18h57

Allez, parce que je suis de bonne humeur aujourd'hui.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
Option Explicit
 
Sub test()
 
Dim myPath As String, myFile As String, myPassword As String
Dim maFeuil As Worksheet
Dim oDate As Date
Dim oCount As Long
 
'Défini le chemin
myPath = "C:\Users\...\Desktop\test"
myFile = Dir(myPath & "\*.*")
 
With Worksheets("Feuil1")
    Do While myFile <> ""
        oDate = DateSerial(Left(myFile, 4), Mid(myFile, 5, 2), Mid(myFile, 7, 2))
 
        If oDate >= .Range("A2") And oDate <= .Range("B2") Then
            Call ClasseurOuvert(myPath & "\" & myFile)
 
            If Right(myFile, 4) Like ".xls*" Then
                With Workbooks(myFile)
                    If FeuilleExiste("Sheet") Then
                        Set maFeuil = .Worksheets("Sheet")
                        oCount = ma_fonction(maFeuil)
                    Else
                        MsgBox "Le classeur " & myFile & " ne présente pas d'onglets ""Sheet""."
                    End If
 
                    .Close True
                End With
            Else
                MsgBox "Le fichier " & myFile & " n'est pas une fichier Excel."
            End If
        .Cells(Rows.Count, 4).End(xlUp).Offset(1, 0) = oDate
        .Cells(Rows.Count, 5).End(xlUp).Offset(1, 0) = oCount
 
        End If
 
        myFile = Dir()
    Loop
End With
 
End Sub
 
Function ClasseurOuvert(NomFich)
On Error Resume Next
    Workbooks(NomFich).Activate
    If Err <> 0 Then Workbooks.Open Filename:=NomFich
On Error GoTo 0
End Function
 
Function FeuilleExiste(NomFeuille) As Boolean
Dim f As Object
 
On Error Resume Next
Set f = Sheets(NomFeuille)
 
If Err = 0 Then FeuilleExiste = True
Set f = Nothing
End Function
 
Function ma_fonction(oWksh As Worksheet)
Dim oVal As Long
Dim oRng As Range
Dim i As Integer
 
oVal = 0
With oWksh
    Set oRng = .Range("S1")
    For i = 1 To .Cells(Rows.Count, oRng.Column).End(xlUp).Row - 1
        If oRng.Offset(i, 8) = "O" Then
            oVal = oVal + oRng.Offset(i, 0)
        End If
    Next i
End With
ma_fonction = oVal
End Function

Mets des dates de début et de fin dans A2 et B2.
Défini le chemin où se trouve tous tes fichiers.
Et puis envoi.

Ca va (logiquement

) mettre en D et en E (aux dernières lignes vides) les différentes valeurs que tu souhaites.

Voila, j'ai pas fait 30 000 tests, mais ça à l'air de fonctionner.

N'hésite pas à revenir vers moi.
Cordialement,
Kimy

**julsd24** · 25/08/2015, 14h08

Ca va (logiquement

) mettre en D et en E (aux dernières lignes vides) les différentes valeurs que tu souhaites.

Voila, j'ai pas fait 30 000 tests, mais ça à l'air de fonctionner.

N'hésite pas à revenir vers moi.
Cordialement,
Kimy

Merci beaucoup Kimy pour ton aide précieuse.
Je clôture la discussion avec la mention résolu

Invité · 25/08/2015, 16h53

Bonjour,
j’arrive un peut tard!

Code Version 1 :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub test()
Dim Cnn As Object, Rs As Object, Sql As String, Total As Double
Set Cnn = CreateObject("ADODB.Connection")
  repertoire = ThisWorkbook.Path & "\"
  Fichier = repertoire & "20150817.xls"
  Cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Fichier & ";Extended Properties=""Excel 8.0;HDR=YES; """
  Set Rs = CreateObject("ADODB.Recordset")
  Sql = "Select [Qte A Preparer] from [Sheet$] where [Cli Facture Etb/Serv O/N]='O' AND [Date du]>=#15-08-17# AND [Date du]<=#15-08-21#"
  Rs.Open Sql, Cnn
  While Rs.EOF = False
    Total = Total + Rs("Qte A Preparer").Value
    Rs.MoveNext
  Wend
  Rs.Close
  Cnn.Close
  Set Rs = Nothing
  Set Cnn = Nothing
End Sub

Code Version 2 :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub test()
Dim Cnn As Object, Rs As Object, Sql As String, Total As Double
Set Cnn = CreateObject("ADODB.Connection")
  repertoire = ThisWorkbook.Path & "\"
  Fichier = repertoire & "20150817.xls"
  Cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Fichier & ";Extended Properties=""Excel 8.0;HDR=YES; """
  Set Rs = CreateObject("ADODB.Recordset")
  Sql = "Select Sum([Qte A Preparer]) as SumQte from [Sheet$] where [Cli Facture Etb/Serv O/N]='O' AND [Date du]>=#15-08-17# AND [Date du]<=#15-08-21#"
  Rs.Open Sql, Cnn
  If Rs.EOF = False Then Total = Total + Rs("SumQte").Value
 
  Rs.Close
  Cnn.Close
  Set Rs = Nothing
  Set Cnn = Nothing
End Sub

Sommer des résultats provenant de différents fichiers [XL-2010]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager