Discussion :

[jpma75]

Bonjour,

J'ai une colonne qui va de la ligne 21 à 386, qui correspond à une année.

L'utilisateur double-clique dans la colonne M pour afficher/masquer "Evt"

Code :

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

1
2
Set Rg_1 = Intersect(Target, Range("M21:M386"))
If Not Rg_1 Is Nothing Then ActiveCell.Value = IIf(ActiveCell.Value = "Evt", "", "Evt")

Si je fractionne ladite colonne en 12 afin d'afficher chaque mois, ce code ne fonctionne plus et j'ai pensé faire ça :

Code :

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

Set Rg_1 = Intersect(Target, Union(Range("M21:M386"), Range("Y21:Y386")))

qui ne fonctionne pas !

Si le recours à Union est la solution (ce dont je ne suis pas sûr), l'ajout de 12 Range va rendre le code peu lisible.
y a-t-il un moyen (ou plutôt, quel est le moyen) d'optimiser ce code qui pour l'instant est par ailleurs erroné ?

Nota : mon tableau initial comporte plusieurs colonnes à dupliquer, en plus de la colonne M

En vous remerciant d'avance pour vos lumières,

[jpma75]

Bonjour,

Ça fonctionne (manifestement) mais c'est monstrueux !
(une partie du code)

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
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Rg_Evt As Range
Dim Rg_HF As Range
Dim Rg_Gf As Range
 
Dim Oc_1 As Range
Dim No_1 As Range
Dim De_1 As Range
Dim Ja_1 As Range
Dim Fe_1 As Range
Dim Mr_1 As Range
Dim Av_1 As Range
Dim Ma_1 As Range
Dim Jn_1 As Range
Dim Jt_1 As Range
Dim Ao_1 As Range
Dim Se_1 As Range
Dim O2_1 As Range
 
Dim Oc_2 As Range
Dim No_2 As Range
Dim De_2 As Range
Dim Ja_2 As Range
Dim Fe_2 As Range
Dim Mr_2 As Range
Dim Av_2 As Range
Dim Ma_2 As Range
Dim Jn_2 As Range
Dim Jt_2 As Range
Dim Ao_2 As Range
Dim Se_2 As Range
Dim O2_2 As Range
 
Dim Oc_3 As Range
Dim No_3 As Range
Dim De_3 As Range
Dim Ja_3 As Range
Dim Fe_3 As Range
Dim Mr_3 As Range
Dim Av_3 As Range
Dim Ma_3 As Range
Dim Jn_3 As Range
Dim Jt_3 As Range
Dim Ao_3 As Range
Dim Se_3 As Range
Dim O2_3 As Range
 
    Set Oc_1 = Range("M21:M51")
    Set No_1 = Range("Y21:Y50")
    Set De_1 = Range("AL21:AL51")
    Set Ja_1 = Range("AY21:AY51")
    Set Fe_1 = Range("BL21:BL49")
    Set Mr_1 = Range("BY21:BY51")
    Set Av_1 = Range("CL21:CL50")
    Set Ma_1 = Range("CY21:CY51")
    Set Jn_1 = Range("DL21:DL50")
    Set Jt_1 = Range("DY21:DY51")
    Set Ao_1 = Range("EL21:EL51")
    Set Se_1 = Range("EY21:EY50")
    Set O2_1 = Range("FL21:FL51")
 
    Set Rg_Evt = Intersect(Target, Union(Oc_1, No_1, De_1, Ja_1, Fe_1, Mr_1, Av_1, Ma_1, Jn_1, Jt_1, Ao_1, Se_1, O2_1))
 
    On Error GoTo fin
 
    If Not Rg_Evt Is Nothing Then ActiveCell.Value = IIf(ActiveCell.Value = "Evt", "", "Evt")
'    If Not Rg_HF Is Nothing Then ActiveCell.Value = IIf(ActiveCell.Value = "HF", "", "HF")
'    If Not Rg_Gf Is Nothing Then ActiveCell.Value = IIf(ActiveCell.Value = "gF", "", "gF")
fin:
    Cancel = True
End Sub

Comment rendre cela plus digeste ?
Cdt

[Franc]

Salut, à mon avis ce serait mieux d'utiliser un tableau pour stocker les plages de cellules:

Code :

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

1
2
3
Dim plages(1 To 13) As Range
Set plages(1) = Range("M21:M51")
Set plages(2) = Range("Y21:Y50")

et ensuite parcourir le tableau avec:

Code :

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

1
2
3
For i = 1 To 13
    If Not Intersect(Target, plages(i)) Is Nothing Then
       'suite de ton code...

[jurassic pork]

Hello,
Sachant qu'Union accepte jusqu'à 30 arguments tu peux faire comme ceci en créant une plage nommée :
1 - Tu définis tes 3 plages ( une par année)
2 - Tu sélectionnes l'union de ces 3 plages
3 - Tu crée une plage nommée d'après la sélection.
Ceci n'est à faire qu'une fois
Voici un exemple sachant que comme tu ne nous a pas donné toutes les plages il faut faire des ajustements (rng2 et rng3)

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
Sub GenerateNamedRange()
Dim rng1 As Range, rng2 As Range, rng3 As Range, rngYears As Range
    Set rng1 = Union(Range("M21:M51"), Range("Y21:Y50"), Range("AL21:AL51"), _
                     Range("AY21:AY51"), Range("BL21:BL49"), Range("BY21:BY51"), _
                     Range("CL21:CL50"), Range("CY21:CY51"), Range("DL21:DL50"), _
                     Range("DY21:DY51"), Range("EL21:EL51"), Range("EY21:EY50"), _
                     Range("FL21:FL51"))
    Set rng2 = Union(Range("M121:M151"), Range("Y121:Y150"), Range("AL121:AL151"), _
                     Range("AY121:AY151"), Range("BL121:BL149"), Range("BY121:BY151"), _
                     Range("CL121:CL150"), Range("CY121:CY151"), Range("DL121:DL150"), _
                     Range("DY121:DY151"), Range("EL121:EL151"), Range("EY121:EY150"), _
                     Range("FL121:FL151"))
    Set rng3 = Union(Range("M221:M251"), Range("Y221:Y250"), Range("AL221:AL251"), _
                     Range("AY221:AY251"), Range("BL221:BL249"), Range("BY221:BY251"), _
                     Range("CL221:CL250"), Range("CY221:CY251"), Range("DL221:DL250"), _
                     Range("DY221:DY251"), Range("EL221:EL251"), Range("EY221:EY250"), _
                     Range("FL221:FL251"))
    rng3.Select
    Set rngYears = Union(rng1, rng2, rng3)
    rngYears.Select
    ' Création de la plage nommée d'après la sélection
    ActiveSheet.Names.Add name:="Years", RefersTo:=Selection
End Sub

Utilisation de la plage nommée :

Code :

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

1
2
3
4
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Set Rg_1 = Intersect(Target, Range("Years"))
If Not Rg_1 Is Nothing Then ActiveCell.Value = IIf(ActiveCell.Value = "Evt", "", "Evt")
End Sub

Ami calmant, J.P

[Qwazerty]

Salut

Tu aurais un fichier à nous mettre à dispo.

++
Qwaz

[jpma75]

Bonsoir,

Merci à tous les 3 !

Le plus laborieux étant de définir les plages, je m'en suis tenu à la proposition de Franc. Par ailleurs, je pense qu'Union n'aurait pas fonctionné puisqu'il y a 39 plages (vs 30 arguments d'Union ; si j'ai bien compris).

Il est vraisemblable qu'on puisse encore améliorer le code (complet) qui suit même si en l'état, il fonctionne manifestement très 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
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
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim i As Integer
Dim Rg_Ev As Range
Dim Rg_HF As Range
Dim Rg_Gf As Range
Dim plg(1 To 39) As Range
 
    Set plg(1) = Range("M22:M52")       'oct_1_Ev
    Set plg(2) = Range("Z22:Z51")       'nov_1_Ev
    Set plg(3) = Range("AM22:AM52")     'déc_1_Ev
    Set plg(4) = Range("AZ22:AZ52")     'jan_1_Ev
    Set plg(5) = Range("BM22:BM50")     'fév_1_Ev
    Set plg(6) = Range("BZ22:BZ52")     'mar_1_Ev
    Set plg(7) = Range("CM22:CM51")     'avr_1_Ev
    Set plg(8) = Range("CZ22:CZ52")     'mai_1_Ev
    Set plg(9) = Range("DM22:DM51")     'jun_1_Ev
    Set plg(10) = Range("DZ22:DZ52")    'jlt_1_Ev
    Set plg(11) = Range("EM22:EM52")    'aoû_1_Ev
    Set plg(12) = Range("EZ22:EZ51")    'sep_1_Ev
    Set plg(13) = Range("FM22:FM52")    'oct_2_Ev
 
    Set plg(14) = Range("N22:N52")      'oct_1_HF
    Set plg(15) = Range("AA22:AA51")    'nov_1_HF
    Set plg(16) = Range("AN22:AN52")    'déc_1_HF
    Set plg(17) = Range("BA22:BA52")    'jan_1_HF
    Set plg(18) = Range("BN22:BN50")    'fév_1_HF
    Set plg(19) = Range("CA22:CA52")    'mar_1_HF
    Set plg(20) = Range("CN22:CN51")    'avr_1_HF
    Set plg(21) = Range("DA22:DA52")    'mai_1_HF
    Set plg(22) = Range("DN22:DN51")    'jun_1_HF
    Set plg(23) = Range("EA22:EA52")    'jlt_1_HF
    Set plg(24) = Range("EN22:EN52")    'aoû_1_HF
    Set plg(25) = Range("FA22:FA51")    'sep_1_HF
    Set plg(26) = Range("FN22:FN52")    'oct_2_HF
 
    Set plg(27) = Range("O22:O52")      'oct_1_Gf
    Set plg(28) = Range("AB22:AB51")    'nov_1_Gf
    Set plg(29) = Range("AO22:AO52")    'déc_1_Gf
    Set plg(30) = Range("BB22:BB52")    'jan_1_Gf
    Set plg(31) = Range("BO22:BO50")    'fév_1_Gf
    Set plg(32) = Range("CB22:CB52")    'mar_1_Gf
    Set plg(33) = Range("CO22:CO51")    'avr_1_Gf
    Set plg(34) = Range("DB22:DB52")    'mai_1_Gf
    Set plg(35) = Range("DO22:DO51")    'jun_1_Gf
    Set plg(36) = Range("EB22:EB52")    'jlt_1_Gf
    Set plg(37) = Range("EO22:EO52")    'aoû_1_Gf
    Set plg(38) = Range("FB22:FB51")    'sep_1_Gf
    Set plg(39) = Range("FO22:FO52")    'oct_2_Gf
 
    On Error GoTo fin
 
    For i = 1 To 13
        If Not Intersect(Target, plg(i)) Is Nothing Then ActiveCell.Value = IIf(ActiveCell.Value = "Ev", "", "Ev")
    Next i
 
    For i = 14 To 26
        If Not Intersect(Target, plg(i)) Is Nothing Then ActiveCell.Value = IIf(ActiveCell.Value = "HF", "", "HF")
    Next i
 
    For i = 27 To 39
        If Not Intersect(Target, plg(i)) Is Nothing Then ActiveCell.Value = IIf(ActiveCell.Value = "gF", "", "gF")
    Next i
 
fin:
    Cancel = True
End Sub

Cordialement,