Macro lente et enlever les weekends!
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!:ccool:
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 |