[VBA-E] problème de Date

**aramge** · 02/08/2006, 11h36

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 :

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

**illight** · 02/08/2006, 11h48

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

vais regarder ça

**illight** · 02/08/2006, 12h02

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 :

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

) 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

**aramge** · 03/08/2006, 10h08

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

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

**Elstak** · 03/08/2006, 11h07

Salut,

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

au lieu de faire des if.. end if

tu fais comme ca :

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 :

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

**aramge** · 03/08/2006, 11h41

Ca marche merci

**random** · 03/08/2006, 12h08

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

**Elstak** · 03/08/2006, 13h46

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?

**random** · 03/08/2006, 14h05

oui tu te trompes
ceci est parfaitement automatisable

[VBA-E] problème de Date

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager