Discussion :

[mouftie]

Bonjour,
J'ai un planning dont les feuilles mensuelles sont créées à partir d'un modèle de 31 jrs, remplis de formule.
Quand je créé un nouveau mois, les WE et les jours fériés ont des mises en forme conditionnelles, mais je voudrais effacer toutes les Formules qui sont positionnées ces jour-là, et je voudrai utiliser une méthode Array d'abord pour apprendre et surtout parceque j'ai une procédure évènement qui ensuite doit effacer toute nouvelle saisie ces jours-là. Or ces 2 procédures ensembles entrainent un temps de réponse trop long pour la création de la feuille.
Conc je voudrais remplacer ma procédure

Code :

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

1
2
3
4
5
6
7
'Effacer toutes les formules dans les colonnes de WE & Fériés
    Set Plg = [C5:AG120]
    For Each c In Plg
        If Weekday(Cells(3, c.Column), vbMonday) > 5 or Application.CountIf([FERIES], Cells(3, c.Column) > 0 Then
            c.ClearContents
        End If
    Next c

par une Array du genre

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Dim x As Long, tb(), y As Long
y = 0
For x = Range("C3") To Range("AG3")
    If WorksheetFunction.Weekday(x, 2) <> 6 And WorksheetFunction.Weekday(x, 2)  and 'FERIES ???' <> 7 Then
'j'enregistre la formule de la cellule correspondante dans la plage [C5:AG120] et "" les WE et Feriés
???
y = y+1
 
ReDim Preserve tb(1 to y)
tb(y) = x
end if
next x
range("C5:AG120").value  = tb

Inutile de préciser que je n'ai jamais fait d'Array et qu'il n'y a pas beaucoup de documentation dans les livres ; heureusement qu'il y a ce site et quelques autres...

Merci de votre aide.

[Jean-Philippe André]

Salut,

concernant les cours disponibles, un Array aux stands :
http://silkyroad.developpez.com/vba/tableaux/
http://didier-gonard.developpez.com/...s-tableau-vba/

[issoram]

Bonsoir,

Avec des tableaux, ça devrait ressembler à ça:

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 Test_With_Array()
 
    Dim tabTemp As Variant
    Dim c As Integer
    Dim plg As Range, plage As Range
 
    Set plg = [C5:AG120]
    tabTemp = [C3:AG3].Value
    For c = LBound(tabTemp, 2) To UBound(tabTemp, 2)
        If WorksheetFunction.Weekday(tabTemp(1, c), vbMonday) > 5 Or Application.CountIf([FERIES], tabTemp(1, c)) > 0 Then
            If plage Is Nothing Then
                Set plage = plg.Columns(c)
            Else
                Set plage = Union(plage, plg.Columns(c))
            End If
        End If
    Next c
 
    If Not plage Is Nothing Then plage.ClearContents
 
    Set plage = Nothing: Set plg = Nothing
    Erase tabTemp
 
End Sub

Cordialement

[Invité]

bonjour,
regard ça et adapte le pour créer ton tableau:

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
Sub test()
 Set Plg = [C5:AG120]
    For Each C In Plg
        If DimancheEtFerie(Cells(3, C.Column)) = True Then
            C.ClearContents
        End If
    Next
End Sub
 
' Cette fonction renvoie Vrai si la date transmise est un jour férié
' fixe ou mobile
' les lundis de paques sont calculés 
 
Public Function RetourneDate(M As String, Annee As String) As Date
Dim moi
moi = Array("", "Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Août", "Septembre", "Octobre", "Novembre", "Décembre")
For I = 1 To 12
If UCase("" & moi(I)) = UCase("" & M) Then Exit For
Next
RetourneDate = "01/" & Format(I, "00") & "/" & Annee
End Function
Function DimancheEtFerie(UneDate As Long, Optional DimanchesOuiNon As Boolean = False) As Boolean
' Par défaut la fonction ne considère pas que les Dimanche de Pâques
' et de Pentecôte sont fériés
' il suffit de renseigner l'argument DimanchesOuiNon à True à l'appel de la fonction
' pour les considérer comme fériés
If Weekday(UneDate) = 1 Or Weekday(UneDate) = 7 Then DimancheEtFerie = True: Exit Function
If IsNull(DimanchesOuiNon) Then DimanchesOuiNon = False
 
Dim JFF ' table des fériés fixes (jours)
Dim MFF ' table des fériés fixes (mois)
JFF = Array(1, 1, 8, 14, 15, 1, 11, 25)
MFF = Array(1, 5, 5, 7, 8, 11, 11, 12)
Dim J As Long
Ferie = False
' Recherche dans la table des jours fériés fixes
For J = 0 To 7
If Day(UneDate) = JFF(J) And Month(UneDate) = MFF(J) Then
DimancheEtFerie = True
Exit Function
End If
Next J
Dim FM ' contient les dates des lundis de Paques
'FM = Array(38824, 39181, 39531, 39916, 40273, 40658, 41008, _
'41365, 41750, 42100, 42457, 42842, _
'43192, 43577, 43934, 44291, 44675, _
'45026, 45383, 45768, 46118, 46475, _
'46860, 47210, 47595)
 
FM = Paque(Year(UneDate))
' Recherche si la date est un lundi de paques
' ou jeudi de l'ascension
' ou lundi de pentecôte
'For J = 0 To 24 ' à changer si vous allez au delà de 2030
If (UneDate = FM) Or (UneDate = FM + 39) Or (UneDate = FM + 50) Then
DimancheEtFerie = True
Exit Function
End If
' si DimanchesOuiNon est vrai
' on teste les dimanches de Pâques et Pentecote
 
 
If DimanchesOuiNon Then
If (UneDate = FM - 1) Or (UneDate = FM + 48) Then
DimancheEtFerie = True
Exit Function
End If
End If
'Next J
End Function
Function IsDimange(J) As Boolean
 
If Weekday(J) = 1 Then IsDimange = True
End Function
Function MDDIF(A, B) As Long
MDDIF = DateDiff("d", A, B)
End Function
Function MuMod(V, D)
MuMod = Int(V / D)
End Function
Function Paque(Annee As Integer) As Date
Dim A, B, C, D, E, F, G, H, I, J, K, L, M, N, O
C = Annee - 1900
D = C Mod 19
E = (D * 7) + 1
F = Int(E / 19)
G = 11 * D - F + 4
H = G Mod 29
I = Int(C / 4)
J = C - H + I + 31
L = J Mod 7
K = J Mod 7
L = 25 - H - K
M = CDate("31/03/" & Annee)
Paque = M + L
End Function

[mouftie]

Bonjour,
Merci jpcheck, j'ai déjà pris connaissance de ces pages à plusieurs reprises, mais je ne maitrise toujours pas les Arrays, mais je ne désespère pas...

Merci rdurupt, j'avais déjà écrit une procédure dans le même sens, mais le temps de réponse est trop long, à cause d'une marco évènement, mais sinon, ça fonctionne parfaitement. Merci encore.

Merci issoram, ça fonctionne parfaitement, sans incidence avec la macro évènement, et en moins d'une seconde. Merci beaucoup pour ton aide, car ce n'est certainement pas la 1ère application Array par laquelle commencer pour apprendre, c'est quand même un peu compliquer, mais le fait d'avoir beaucoup essayé me permet de comprendre ce que tu as fait pour moi.

Bonne journée à tous.