Intersect (Union) Range

Version imprimable

14/08/2023, 16h34
jpma75

Intersect (Union) Range
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:

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:

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,

Bonjour,

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

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

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

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:

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

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:

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:

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

15/08/2023, 12h31
Qwazerty

Salut

Tu aurais un fichier à nous mettre à dispo.

++
Qwaz

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:

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,

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

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

Citation:

Envoyé par jpma75

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:

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

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:

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 :

Citation:

$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:

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