Macro lente et enlever les weekends! [Résolu]

[moi244]

Bonjour,
deux problèmes reliés:
1) d'abord en exécutant ce code je trouve qu'il est lent, il faut dire que "For...Next" ce n'est pas mon fort!
2) Je vais expliquer mon problème en donnant un exemple concret:
dans mon UserForm j'ai deux DTpicker (donc c'est une période):
DTPicker1=2011-11-17
DTPicker2=2011-11-21, je souhaiterais enlever les weekends entre les deux dates:
A7=2011-11-17
A8=2011-11-18
A9=2011-11-21
Pour cela je dois régler la lenteur du 1) imagine sur une période de 3 mois!
Merci Beaucoup!

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
Private Sub CommandButton1_Click()
 
Worksheets("feuil2").Visible = xlSheetHidden
 
Worksheets("stats_perso").Visible = xlSheetVisible
Sheets("stats_perso").Range("a6").Value = ComboBox1
Sheets("stats_perso").Range("a7").Value = DTPicker1
 
choix = ComboBox1.ListIndex + 1
 
If TextBox1.Value = Sheets("Database").Cells(choix, 3).Value Then
 
var1 = ComboBox1.Text
var2 = DTPicker1
 
Set f = Sheets("Feuil1").Range("f2:f20000")
Set o = Sheets("Feuil1").Range("o2:o20000")
Set p = Sheets("Feuil1").Range("p2:p20000")
Set r = Sheets("Feuil1").Range("r2:r20000")
Set s = Sheets("Feuil1").Range("s2:s20000")
Set x = Sheets("Feuil1").Range("x2:x20000")
Set y = Sheets("Feuil1").Range("y2:y20000")
Set z = Sheets("Feuil1").Range("z2:z20000")
Set aa = Sheets("Feuil1").Range("aa2:aa20000")
Set af = Sheets("Feuil1").Range("af2:af20000")
Set ah = Sheets("Feuil1").Range("ah2:ah20000")
Set ai = Sheets("Feuil1").Range("ai2:ai20000")
Set aj = Sheets("Feuil1").Range("aj2:aj20000")
Set ak = Sheets("Feuil1").Range("ak2:ak20000")
Set ao = Sheets("Feuil1").Range("ao2:ao20000")
Set ax = Sheets("Feuil1").Range("ax2:ax20000")
Set ay = Sheets("Feuil1").Range("ay2:ay20000")
Set bb = Sheets("Feuil1").Range("bb2:bb20000")
Set be = Sheets("Feuil1").Range("be2:be20000")
Set bg = Sheets("Feuil1").Range("bg2:bg20000")
Set bh = Sheets("Feuil1").Range("bh2:bh20000")
Set bi = Sheets("Feuil1").Range("bi2:bi20000")
 
'Set C = Range("G2:G1000")
For i = 1 To p.Count
A = A + (f(i) = var1) * (o(i) = var2) '* C(i)
B = B + (f(i) = var1) * (p(i) = var2) '* C(i)
C = C + (f(i) = var1) * (r(i) = var2)
d = d + (f(i) = var1) * (s(i) = var2)
e = e + (f(i) = var1) * (x(i) = var2)
g = g + (f(i) = var1) * (y(i) = var2)
h = h + (f(i) = var1) * (z(i) = var2)
j = j + (f(i) = var1) * (aa(i) = var2)
k = k + (f(i) = var1) * (af(i) = var2)
l = l + (f(i) = var1) * (ah(i) = var2)
m = m + (f(i) = var1) * (ai(i) = var2)
n = n + (f(i) = var1) * (aj(i) = var2)
q = q + (f(i) = var1) * (ak(i) = var2)
t = t + (f(i) = var1) * (ao(i) = var2)
u = u + (f(i) = var1) * (ax(i) = var2)
v = v + (f(i) = var1) * (ay(i) = var2)
w = w + (f(i) = var1) * (bb(i) = var2)
ab = ab + (f(i) = var1) * (be(i) = var2)
ac = ac + (f(i) = var1) * (bg(i) = var2)
ad = ad + (f(i) = var1) * (bh(i) = var2)
ae = ae + (f(i) = var1) * (bi(i) = var2)
 
Next
Sheets("stats_perso").Range("b7") = A
Sheets("stats_perso").Range("c7") = B
Sheets("stats_perso").Range("d7") = C
Sheets("stats_perso").Range("e7") = d
Sheets("stats_perso").Range("f7") = e
Sheets("stats_perso").Range("g7") = g
Sheets("stats_perso").Range("h7") = h
Sheets("stats_perso").Range("i7") = j
Sheets("stats_perso").Range("j7") = k
Sheets("stats_perso").Range("k7") = l
Sheets("stats_perso").Range("l7") = m
Sheets("stats_perso").Range("m7") = n
Sheets("stats_perso").Range("n7") = q
Sheets("stats_perso").Range("o7") = t
Sheets("stats_perso").Range("p7") = u
Sheets("stats_perso").Range("q7") = v
Sheets("stats_perso").Range("r7") = w
Sheets("stats_perso").Range("s7") = ab
Sheets("stats_perso").Range("t7") = ac
Sheets("stats_perso").Range("u7") = ad
Sheets("stats_perso").Range("v7") = ae
 
 
ComboBox1.Text = Sheets("stats_perso").Range("a1")
 
'pour effacer le mot de pass
TextBox1.Value = ""
Me.Hide
Else
MsgBox (ComboBox1.Text & "  votre mot de passe est erronné")
 
TextBox1.Value = ""
End If
End Sub

[Access Newbie]

Bonjour,

Je ferai quelque chose dans cet esprit :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Dim dt1 As Date, dt2 As Date, dt3 As Date
Dim i As Integer
Dim cpt As Integer
 
dt1 = "17/11/2011"
dt2 = "21/11/2011"
 
With Worksheets("Feuil2")
    For i = 0 To DateDiff("d", dt1, dt2)
        dt3 = DateAdd("d", i, dt1)
        If Weekday(dt3) <> vbSaturday And Weekday(dt3) <> vbSunday Then
            .Cells(.Range("A" & .Rows.Count).End(xlUp).Row + 1, 1) = dt3
        End If
    Next i
End With

(En supposant que l'on écrive le résultat sur la feuille "Feuil2")

Si vous avez des dates qui ont un format différent (par exemple avec des - à la place des / ou autre, utilisez la fonction dateserial)

[moi244]

Le code que vous m'avez donné marche trè bien pour mettre des date qui se suivent dans une colonne.
Le problème c'est que la macro fait le calcul seulement sur la première date, je pense que mon code est vraiment Basic Comment ferais-je por qu'il continu le calcul sur chacune des lingnes de la date de début à la date de Fin.
Je vous rappel que le but du code c'est comme une SOMMEProd.
Please HELP!!!

[Access Newbie]

Bonjour,

Essaie d'expliquer ce que tu veux avec des mots et pas avec un bout de code.

Donne un jeu de données d'entrée et le resultat que tu attends.

Là tu me parles de sommepprod alors que dans ton premier post tu ne parles que de dates.

Expliques nous ce que tu veux en bon francois

[moi244]

les données sont à la feuille Données:
SOMMEPROD((Données!$A$4:$A$16=$A$2)*(Données!B$4:B$16=Calcul!A4))
Le résultat marche très bien avec la sommeprod, mais je veux tout cela par macro, voici pourquoi;

Le vendeur x peut varier à partir du UserForm et la date1 et la date2 (A4 à A8) aussi peuvent varier, donc les période peuvent être plus longues.

Donc la question est: pour le vendeur X (à partitr du textbox1), combien il ya de dates qui sont du la date1 (ici 2011-11-16) à l'étape 1, et 2 et 3. le résultat vas dans chacune des cellule qui correspond à l'étape. (ici, le 16 c'est la ligne 4 et l'étape1 c'est la colonne B, donc le résultat va à la cellule B4 et ainsi de suite)



Mêm question pour le lendemain de la date1, et ce, jusqu'à la date2.
pour mieux comprendre, tu peux cliquer sur une des cellule B4 à D8 pour voir la formule avec sommeprod.

[Access Newbie]

Je ne comprends pas le résultat que tu attends.


L'utilisateur doit choisir un vendeur et une période (date de début à la date de fin)

Et il doit voir la même chose que ce que l'on voit sur la feuille calcul ?

Pourquoi n'as-tu pas mis le vrai user form plutot qu une image ?

Quel code s'execute lorsqu'on clique sur le bouton OK ?

[moi244]

Envoyé par Access Newbie

Je ne comprends pas le résultat que tu attends.

L'utilisateur doit choisir un vendeur et une période (date de début à la date de fin)

Et il doit voir la même chose que ce que l'on voit sur la feuille calcul ?

oui, mai sil ne peut rien modifier

Envoyé par Access Newbie

Pourquoi n'as-tu pas mis le vrai user form plutot qu une image ?

parcque j,ai tout refait et iL n'a pas de code derrière, je sais que la macro que j'avais fait au début faist référence à chacune des cellue, mais comme les dates vont varien les cellules de calcul aussi.

Envoyé par Access Newbie

Quel code s'execute lorsqu'on clique sur le bouton OK ?

le code qui s'exécute, c'est celui qui remplace Sommeprod dans les cellule B4:D8

Ok je viens de joindre le fichier avec la macro qui fait très bien le calcul sur une seule ligne! Vous allez tout comprendre!

Voici le code:
'****************************ça fait le calcul seulement sur une seule ligne (ici 4),
'mon but est que la macro fait le calcul pour chacune des lignes de la colonne A
'où il ya une date (la colonne A contient plusuiers dates qui s'étendent sur la période choisie
'entre la date1 et la date2)

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
Private Sub CommandButton1_Click()
 
ActiveWorkbook.RefreshAll
Dim dt1 As Date, dt2 As Date, dt3 As Date
Dim i As Integer
Dim cpt As Integer
 
dt1 = DTPicker1
dt2 = DTPicker2
'***************remplir la colonne A par les dates de la période Date1 à date2
With Worksheets("Calcul")
    For i = 0 To DateDiff("d", dt1, dt2)
        dt3 = DateAdd("d", i, dt1)
'        If Weekday(dt3) <> vbSaturday And Weekday(dt3) <> vbSunday Then
            .Cells(.Range("A" & .Rows.Count).End(xlUp).Row + 1, 1) = dt3
'        End If
    Next i
End With
'**********mettre quelques infos dans la feuille***********
Sheets("Calcul").Range("b1").Value = ComboBox1
Sheets("Calcul").Range("b2").Value = DTPicker1
Sheets("Calcul").Range("c2").Value = DTPicker2
' ***********le calcul******************
var1 = ComboBox1.Text
var2 = DTPicker1
 
 
Set a = Sheets("Données").Range("a2:a20000")
Set B = Sheets("Données").Range("b2:b20000")
Set C = Sheets("Données").Range("c2:c20000")
Set D = Sheets("Données").Range("d2:d20000")
 
    For i = 1 To D.Count
 
 
        e = e + (a(i) = var1) * (B(i) = var2)
        f = f + (a(i) = var1) * (C(i) = var2)
        j = f + (a(i) = var1) * (D(i) = var2)
 
    Next
        Sheets("Calcul").Range("b4") = e
        Sheets("Calcul").Range("c4") = f
        Sheets("Calcul").Range("d4") = j
 
 
Me.Hide
 
End Sub

[Access Newbie]

Hum ... plus on avance moins je comprends ...

Dans ta feuille données, sur l'étape 3 et pour le vendeur x, tu n'as pas de date au 16/11/2011, je ne vois pas vraiment par quel miracle je vais pouvoir ramener la valeur 1 ...

Tu dis :

Le résultat marche très bien avec la sommeprod, mais je veux tout cela par macro

Mais le resultat attendu que tu me montres est différent du résultat obtenu par sommeprod, même sur la première ligne ...

[ZebreLoup]

Essaie ça

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
Private Const FIRST_ROW_DB = "A4"
 
Private Function Denombrer(ByVal vendeur As String, ByVal dt As Date _
    , ByVal etapNum As Integer) As Integer
 
    Dim nb As Integer
    Dim i As Integer
    Dim ws As Worksheet
    Dim rg As Range
    Set ws = Worksheets("Données")
    Set rg = ws.Range(FIRST_ROW_DB)
 
    i = 0
    nb = 0
 
    While rg.Offset(i, 0).Value <> ""
        If rg.Offset(i, 0).Value = vendeur And rg.Offset(i, etapNum).Value = dt Then
            nb = nb + 1
        End If
        i = i + 1
    Wend
 
    Denombrer = nb
End Function
 
Private Sub CommandButton1_Click()
 
ActiveWorkbook.RefreshAll
Dim dt1 As Date, dt2 As Date, dt3 As Date
Dim i As Integer
Dim cpt As Integer
 
dt1 = DTPicker1
dt2 = DTPicker2
'***************remplir la colonne A par les dates de la période Date1 à date2
Dim ws As Worksheet
Set ws = Worksheets("Calcul")
 
Dim lastRow As Integer
lastRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row + 1
 
For i = 0 To DateDiff("d", dt1, dt2)
    dt3 = DateAdd("d", i, dt1)
'   If Weekday(dt3) <> vbSaturday And Weekday(dt3) <> vbSunday Then
        ws.Cells(lastRow, 1) = dt3
        ws.Cells(lastRow, 2) = Denombrer(ComboBox1.Value, dt3, 1)
        ws.Cells(lastRow, 3) = Denombrer(ComboBox1.Value, dt3, 2)
        ws.Cells(lastRow, 4) = Denombrer(ComboBox1.Value, dt3, 3)
        lastRow = lastRow + 1
'    End If
Next i
 
'**********mettre quelques infos dans la feuille***********
Sheets("Calcul").Range("b1").Value = ComboBox1
Sheets("Calcul").Range("b2").Value = DTPicker1
Sheets("Calcul").Range("c2").Value = DTPicker2
' ***********le calcul******************
 
 
Unload Me
 
End Sub