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,

[Franc]

Je trouve un peu fastidieux toutes ces commandes Set, voici donc une version qui me semble plus facile à maintenir:

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
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim i As Integer
    Dim plg(1 To 39) As Range
    Dim monthRanges As Variant
    Dim cell As Range
 
    ' Assigner les plages pour chaque mois
    monthRanges = Array( _
        "M22:M52", "Z22:Z51", "AM22:AM52", "AZ22:AZ52", "BM22:BM50", "BZ22:BZ52", _
        "CM22:CM51", "CZ22:CZ52", "DM22:DM51", "DZ22:DZ52", "EM22:EM52", "EZ22:EZ51", "FM22:FM52", _
        "N22:N52", "AA22:AA51", "AN22:AN52", "BA22:BA52", "BN22:BN50", "CA22:CA52", _
        "CN22:CN51", "DA22:DA52", "DN22:DN51", "EA22:EA52", "EN22:EN52", "FA22:FA51", "FN22:FN52", _
        "O22:O52", "AB22:AB51", "AO22:AO52", "BB22:BB52", "BO22:BO50", "CB22:CB52", _
        "CO22:CO51", "DB22:DB52", "DO22:DO51", "EB22:EB52", "EO22:EO52", "FB22:FB51", "FO22:FO52" _
    )
 
 
    ' Remplir le tableau plg avec les plages spécifiées
    For i = 1 To 39
        Set plg(i) = Range(monthRanges(i - 1))
    Next i
 
    On Error GoTo fin
 
    ' Parcourir le tableau plg et vérifier l'intersection avec la cellule cible
    For i = 1 To 39
        For Each cell In plg(i)
            If Not Intersect(Target, cell) Is Nothing Then
                Select Case i
                    Case 1 To 13
                        ActiveCell.Value = IIf(ActiveCell.Value = "Ev", "", "Ev")
                    Case 14 To 26
                        ActiveCell.Value = IIf(ActiveCell.Value = "HF", "", "HF")
                    Case 27 To 39
                        ActiveCell.Value = IIf(ActiveCell.Value = "gF", "", "gF")
                End Select
                Exit For
            End If
        Next cell
    Next i
 
fin:
    Cancel = True
End Sub

[Qwazerty]

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

En fait, tu peux réaliser une boucle qui incrémente une variable range en agglomérant des union. Le code ferait un truc comme ça (pas testé)

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
Dim MaPlage as range
dim tab_Month

tab_Month= Array( _
        "M22:M52", "Z22:Z51", "AM22:AM52", "AZ22:AZ52", "BM22:BM50", "BZ22:BZ52", _
        "CM22:CM51", "CZ22:CZ52", "DM22:DM51", "DZ22:DZ52", "EM22:EM52", "EZ22:EZ51", "FM22:FM52", _
        "N22:N52", "AA22:AA51", "AN22:AN52", "BA22:BA52", "BN22:BN50", "CA22:CA52", _
        "CN22:CN51", "DA22:DA52", "DN22:DN51", "EA22:EA52", "EN22:EN52", "FA22:FA51", "FN22:FN52", _
        "O22:O52", "AB22:AB51", "AO22:AO52", "BB22:BB52", "BO22:BO50", "CB22:CB52", _
        "CO22:CO51", "DB22:DB52", "DO22:DO51", "EB22:EB52", "EO22:EO52", "FB22:FB51", "FO22:FO52" _
    )For 1 to ubound(Tab_Month)
   if MaPlage is nothing then
      Set MaPlage = Feuil1.Range(Tab_Month(i)
   else
      Set MaPlage = Union(MaPlage, Feuil1.Range(Tab_Month(i))
   end if
Next

Attention quand même, il y a une limite en terme de nombre de cellules, je ne me souviens plus exactement mais j'avais rencontré un problème sur un fichier avec cette méthode.

Ceci dit, je pense que ce fonctionnement est un peu aberrant. Il y a d'autres solutions je pense. Je renouvèle ma demande de fichier pour être sur de bien comprendre ce que tu souhaite faire. Ou à minima un screenshot, je souhaite voir s'il y a des plage fusionnées par exemple.

++
Qwaz

[jurassic pork]

Hello,
en considérant que l'écart entre les colonnes à tester est toujours le même (dans le cas présent 13) voici une solution qui va calculer les cellules à tester d'après la cellule de départ pour chaque année. Dans un premier temps la solution calcule la plage à tester pour chaque année et crée une plage nommée pour chaque année (dans le cas présent Year1, Year2 et Year3). Ceci n'est à faire qu'une seule fois. Dans l'événement Double clic de la feuille on teste si la cellule qui a été double cliquée est dans une des 3 plages nommées si oui selon la plage on effectue l'action désirée.
Voici le code de la génération des plages nommées :

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
Sub GenerateNamedRange()
Dim dep As Range, Rng As Range, ws As Worksheet
Dim x As Integer, i As Integer
    jM = Array(31, 30, 31, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31)  'Nb jours par Mois
    jMb = Array(31, 30, 31, 31, 29, 31, 30, 31, 30, 31, 31, 30, 31) 'Année bissextile
    cellDep = Array("M22", "N22", "O22") 'cellule de départ
    bis = Array(False, False, False) 'année bissextile ou pas
    Set ws = Sheets("Feuil1")
    For x = 0 To 2
        Set dep = ws.Range(cellDep(x))
        For i = 0 To 12
            If Rng Is Nothing Then
               If bis(x) Then
                 Set Rng = Range(dep.offset(0, i * 13), dep.offset(jMb(i) - 1, i * 13))
               Else
                 Set Rng = Range(dep.offset(0, i * 13), dep.offset(jM(i) - 1, i * 13))
               End If
            Else
               If bis(x) Then
                  Set Rng = Union(Rng, Range(dep.offset(0, i * 13), dep.offset(jMb(i) - 1, i * 13)))
               Else
                  Set Rng = Union(Rng, Range(dep.offset(0, i * 13), dep.offset(jM(i) - 1, i * 13)))
               End If
            End If
        Next i
        Debug.Print Rng.Address
        ws.Names.Add name:="Year" + CStr(x + 1), RefersTo:=Rng
        Set Rng = Nothing
    Next x
End Sub

Voici les plages générées :

$M$22:$M$52,$Z$22:$Z$51,$AM$22:$AM$52,$AZ$22:$AZ$52,$BM$22:$BM$49,$BZ$22:$BZ$52,$CM$22:$CM$51,$CZ$22:$CZ$52,$DM$22:$DM$51,$DZ$22:$DZ$52,$EM$22:$EM$52,$EZ$22:$EZ$51,$FM$22:$FM$52
$N$22:$N$52,$AA$22:$AA$51,$AN$22:$AN$52,$BA$22:$BA$52,$BN$22:$BN$49,$CA$22:$CA$52,$CN$22:$CN$51,$DA$22:$DA$52,$DN$22:$DN$51,$EA$22:$EA$52,$EN$22:$EN$52,$FA$22:$FA$51,$FN$22:$FN$52
$O$22:$O$52,$AB$22:$AB$51,$AO$22:$AO$52,$BB$22:$BB$52,$BO$22:$BO$49,$CB$22:$CB$52,$CO$22:$CO$51,$DB$22:$DB$52,$DO$22:$DO$51,$EB$22:$EB$52,$EO$22:$EO$52,$FB$22:$FB$51,$FO$22:$FO$52

On retrouve bien les plages prévues sauf pour la colonne de février qui dans l'exemple de jpma75 correspond à des années bissextiles (29 jours) ce qui est louche si les trois années sont consécutives. Moi j'ai mis le cas ou les années ne sont pas bissextiles.

et voici le code de l'événement beforeDoubleClick de la feuille à traiter :

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
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim x As Integer, Rng As Range
For x = 1 To 3
    If Not Intersect(Target, Range("Year" + CStr(x))) Is Nothing Then
       Select Case x
             Case 1
                Target.Value = IIf(Target.Value = "Evt", "", "Evt")
             Case 2
                Target.Value = IIf(Target.Value = "HF", "", "HF")
             Case 3
                Target.Value = IIf(Target.Value = "gF", "", "gF")
       End Select
    Exit For
    End If
Next x
Cancel = True
End Sub

Ami calmant, J.P