[VBA-E] problème de Date

Version imprimable

Bonjour,

je dispose d'un fichier de plusieurs décisions déroulées chacune sur une ligne Excel.

Je dois compter le nombre de décisions qui ont été prises entre deux Dates. Jusque là pas de problèmes (Voir le code, cela fonctionne bien)
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 Sub requete() Dim i As Integer, a As Integer Dim f As Worksheet, g As Worksheet Dim d1 As Date, d2 As Date, d3 As Date Set f = ThisWorkbook.Worksheets("AGO") Set g = ThisWorkbook.Worksheets("EC_sur_1_an") d1 = g.Cells(2, 4).Value d2 = g.Cells(2, 6).Value MsgBox "D1 = " & d1 & " et D2 = " & d2 d3 = Month(d1) MsgBox "D3 = " & d3 a = 0 For i = 6 To 1000 ''''''''' Total If d1 <= f.Cells(i, 3).Value And f.Cells(i, 3).Value <= d2 Then a = a + 1 End If Next i g.Cells(5, 1).Value = a g.Activate End Sub
Mais cela se complique car je dois aussi compter le nombre de décision par mois entre les deux dates. Et là je ne vois pas comment faire.

Si quelqu'un pouvait m'aider.

Merci

02/08/2006, 11h48
illight

déja il faut que tu prenne le mois de ta deuxième date :)

Ensuite, pour faire cela, personnellement j'aurai pas fait avec une macro mais avec un tableau croisé dynamique, en créant dans ton fichier excel une colonne ou tu aura le mois :)
Ensuite, dans ton TCD, tu prend le mois le nombre de décision, puis tu classes par date dans l'ordre croissant et tu auras ton tableau dans les dates que tu désires :)

Par macro, je vois pas trop comment faire entre 2 dates et suivant le mois :? A moins que..Tu prenne dans ta fonction en compte les mois de ta première date et tu l'incrémente pour chaque mois, en utilisant un DateAdd :aie: vais regarder ça :mrgreen:

Me revla..
il faut peut etre faire comme ça (je n'ai pas testé mais c'est a toi après de l'accomoder a ton code :) ), et c'est une idée comme ça en l'air que je lance :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 nbremois = datediff("m",d1,d2) b = 0 if nbremois = 0 then For i = 6 To 1000 ''''''''' Total If d1 <= f.Cells(i, 3).Value And f.Cells(i, 3).Value <= d2 Then a = a + 1 End If Next i else firstmonth = month(d1) for n = firstmonth to fisrtmonth + nbremois for j = 6 to 1000 If d1 <= f.Cells(i, 3).Value And f.Cells(i, 3).Value <= d2 and firstmonth = n Then a = a +1 b = b+1 end if next j next n end if
Ce code ne marche surement pas il faut peut etre le bidouiller un peu pour qu'il fonctionne correctement :)
Je t'ai juste donné une idée de comment tu pourrais faire (en espérant que ut la comprenne :mrgreen: ) après faut que tu écrive le code car je pense que cleui la n'est pas très bon, mais c'est, je pense, dans ce gout la :)

j'ai trouvé une solution mais j'aurais voulu savoir si mon code ne pouvait pas être allégé merci.

Code:

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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
Sub requete()
    Dim i As Integer, Total As Integer, j As Integer
    Dim janv As Integer, fev As Integer, mars As Integer, avr As Integer, mai As Integer
    Dim juin As Integer, juil As Integer, aout As Integer, sept As Integer, oct As Integer
    Dim nov As Integer, dec As Integer
    Dim f As Worksheet, g As Worksheet
    Dim d1 As Date, d2 As Date
    Dim nbremois As Integer, firstmonth As Integer, lastmonth As Integer
 
    Set f = ThisWorkbook.Worksheets("AGO")
    Set g = ThisWorkbook.Worksheets("EC_sur_1_an")
 
    d1 = g.Cells(2, 4).Value
    d2 = g.Cells(2, 6).Value
    MsgBox "D1 = " & d1 & " et D2 = " & d2
 
    'nbremois = DateDiff("m", d1, d2)
    'firstmonth = Month(d1)
 
 
 
    '''''''' Initialisation
    Total = 0
    janv = 0
    fev = 0
    mars = 0
    avr = 0
    mai = 0
    juin = 0
    juil = 0
    aout = 0
    sept = 0
    oct = 0
    nov = 0
    dec = 0
 
    nbremois = DateDiff("m", d1, d2)
    firstmonth = Month(d1)
    lastmonth = Month(d2)
 
 
    For i = 6 To 1000
        ''''''''' Total
        If d1 <= f.Cells(i, 3).Value And f.Cells(i, 3).Value <= d2 Then
            Total = Total + 1
        End If
        ''''''''' Janvier
        If d1 <= f.Cells(i, 3) And f.Cells(i, 3).Value < d2 And Month(f.Cells(i, 3).Value) = 1 Then
            janv = janv + 1
        End If
        If d1 <= f.Cells(i, 3) And f.Cells(i, 3).Value < d2 And Month(f.Cells(i, 3).Value) = 2 Then
            fev = fev + 1
        End If
        If d1 <= f.Cells(i, 3) And f.Cells(i, 3).Value < d2 And Month(f.Cells(i, 3).Value) = 3 Then
            mars = mars + 1
        End If
        If d1 <= f.Cells(i, 3) And f.Cells(i, 3).Value < d2 And Month(f.Cells(i, 3).Value) = 4 Then
            avr = avr + 1
        End If
        If d1 <= f.Cells(i, 3) And f.Cells(i, 3).Value < d2 And Month(f.Cells(i, 3).Value) = 5 Then
            mai = mai + 1
        End If
        If d1 <= f.Cells(i, 3) And f.Cells(i, 3).Value < d2 And Month(f.Cells(i, 3).Value) = 6 Then
            juin = juin + 1
        End If
        If d1 <= f.Cells(i, 3) And f.Cells(i, 3).Value < d2 And Month(f.Cells(i, 3).Value) = 7 Then
            juil = juil + 1
        End If
        If d1 <= f.Cells(i, 3) And f.Cells(i, 3).Value < d2 And Month(f.Cells(i, 3).Value) = 8 Then
            aout = aout + 1
        End If
        If d1 <= f.Cells(i, 3) And f.Cells(i, 3).Value < d2 And Month(f.Cells(i, 3).Value) = 9 Then
            sept = sept + 1
        End If
        If d1 <= f.Cells(i, 3) And f.Cells(i, 3).Value < d2 And Month(f.Cells(i, 3).Value) = 10 Then
            oct = oct + 1
        End If
        If d1 <= f.Cells(i, 3) And f.Cells(i, 3).Value < d2 And Month(f.Cells(i, 3).Value) = 11 Then
            nov = nov + 1
        End If
        If d1 <= f.Cells(i, 3) And f.Cells(i, 3).Value < d2 And Month(f.Cells(i, 3).Value) = 12 Then
            dec = dec + 1
        End If
    Next i
 
 
    g.Cells(5, 1).Value = Total
    g.Cells(5, 2).Value = janv
    g.Cells(5, 3).Value = fev
    g.Cells(5, 4).Value = mars
    g.Cells(5, 5).Value = avr
    g.Cells(5, 6).Value = mai
    g.Cells(5, 7).Value = juin
    g.Cells(5, 8).Value = juil
    g.Cells(5, 9).Value = aout
    g.Cells(5, 10).Value = sept
    g.Cells(5, 11).Value = oct
    g.Cells(5, 12).Value = nov
    g.Cells(5, 13).Value = dec
 
    g.Activate
End Sub

03/08/2006, 11h07
Elstak

Salut,

Déjà tu peux diminuer la nombre de comparaisons.

au lieu de faire des if.. end if

tu fais comme ca :

Citation:

si le nombre est compris entret tes 2 dates et mois=1 alors
...
SINON
si le nombre est compris entret tes 2 dates et mois=2 alors
...
etc...

de cette maniere si ton mois est janvier (ce ne sera donc jamais fevrier etc...) tu economise 11 comparaisons car tu ne passe pas dans le sinon.

tu peux meme faire comme ceci :

Citation:

si ta date est comprise entre d1 et d2 alors
si mois=1
....
sinon
si mois=2...

de cette maniere tu ne recopie pas ta condition (date cmprise entre d1 et d2) à chaque fois
03/08/2006, 11h41
aramge

Ca marche merci
03/08/2006, 12h08
random

sans une ligne de programmation

si j'ai dans mon classeur c:\monclasseur.xls
une feuille avec

date décision
date1 dec1
date2 dec2
etc

je nomme mabase la zone depuis date décision les 5000 lignes situées dessous

je me place hors de la zone mabase et je place les cellules suivantes

début fin
date2 date100

j'enregistre

je me place alors où je veux loger mes résultats

je fais données <données externes< créer une requête <excel files*
je sélectionne
c:\monclasseur.xls
puis
mabase
je deploie et ajoute date et décision
je fais suivant jusqu'à afficher les données dans microsoft query
j'affiche le sql et remplace date par month date
j'ajoute le count sur décision
j'ajoute un critere sur date >=[debut] and <=[fin]
j'obtiens ls sql suivant

SELECT month(date) AS 'mois', Count(mabase.decis) AS 'Nombre sur decis'
FROM `c:\mabase`.mabase mabase
WHERE (mabase.date>=? And mabase.date<=?)
GROUP BY month(date)

je demande l'enregistrement de la requête et le renvoi des données vers excel

dans l'assistant qui apparaiit je clique sur le bouton paramètres
je fixe les paramètres début et fin à leurs valeurs date1 et date2
en indiquant les ref des cellules
avec option actualiser lorsque la cellule est modifiée

si je suis curieux je regarde les autres options
03/08/2006, 13h46
Elstak

sans une ligne de code peut etre mais s'il veut automatiser ca pour d'autres fichiers, il sera bien obligé de faire un code qui fasse ce que tu decris (qui est fait manuellement).

je me trompe?
03/08/2006, 14h05
random

oui tu te trompes
ceci est parfaitement automatisable
03/08/2006, 14h17
Elstak

Oui je sais que c'est automatisable !

mais SANS code?? c'est ca qui me suprend !

comment tu fais? :?