Fonction .dependants dans une union range

Le 08/12/2022 à 10:06

Bonjour à toutes et à tous !

Je coince sur fonction union range .dependants. Je voudrais savoir si il est possible d'attribuer un ".dependants" à ma première RANGE et avoir une RANGE "normal" sur la seconde...

Je vous poste bien sûre le code en exemple:

Union(Range(Cells(68, A + 1), Cells(102, A + 1)).Dependents, Range(Cells(68, A + 8), Cells(102, A + 8)))

qui est utilisé dans une fonction If not intersect :

If Not Intersect(Target, Union(Range(Cells(68, A + 1), Cells(102, A + 1)).Dependents, Range(Cells(68, A + 8), Cells(102, A + 8)))) Is Nothing Then

Merci par avance,

Bonne journée et bonnes fêtes !

Le 08/12/2022 à 10:41

bonjour,

oui, c'est possible; mais je suppose que si tu poses la question c'est que cela ne fonctionne pas chez toi. La syntaxe est correcte, donc c'est donc probablement lié au classeur.

Le 08/12/2022 à 11:02

Merci pour la réponse rapide et ça m'a permis d'avancer !

En fait mon problème est que je fais référence à la cellule dépendante d'une cellule dans ma range pour le déclenchement de la Sub et que je souhaite récupérer la "Target.Row" de ma cellule cible et non de la cellule dépendante...

Je vous joins le code pour plus de compréhension:

Sub Worksheet_Change(ByVal Target As Range)

Dim A, B, C As Variant
Dim DA As Variant
Dim dateDeb As Date, dateFin1 As Date, dateFin2 As Date, duree1 As Long, duree2 As Long

Debug.Print Target.Address
Debug.Print Target.Offset.Row

Application.EnableEvents = False
If ToggleButton1 = True Then
GoTo Line1
Else: GoTo Line2

Line2:

'LARGEURS DES CELLULES AUTOMATIQUEMENT
  With Target.CurrentRegion
    Target.CurrentRegion.EntireColumn.AutoFit

 'MASQUAGE DES COLONNES / NB DE BÂTIMENT

   If Target.Address = "$B$16" Then 'Après chaque modification de la cellule B16
   'Affiche toutes les colonnes déjà masquées dans la feuille Cible
      With Sheets(ActiveSheet.Name)
          .Cells.EntireColumn.Hidden = False
      'Masque les colonnes en fonction de la valeur de B12
         Select Case Range("B16").Value
            Case ""
               .Columns("H:GF").EntireColumn.Hidden = True
            Case "1"
               .Columns("v:GF").EntireColumn.Hidden = True
            Case "2"
               .Columns("AK:GF").EntireColumn.Hidden = True
            Case "3"
               .Columns("AZ:GF").EntireColumn.Hidden = True
            Case "4"
               .Columns("BO:GF").EntireColumn.Hidden = True
            Case "5"
               .Columns("CD:GF").EntireColumn.Hidden = True
            Case "6"
               .Columns("CS:GF").EntireColumn.Hidden = True
            Case "7"
               .Columns("DH:GF").EntireColumn.Hidden = True
            Case "8"
               .Columns("DW:GF").EntireColumn.Hidden = True
            Case "9"
               .Columns("EL:GF").EntireColumn.Hidden = True
            Case "10"
               .Columns("FA:GF").EntireColumn.Hidden = True
            Case "11"
               .Columns("FP:GF").EntireColumn.Hidden = True

        End Select
    End With

  End If
End With

'LANCEMENT MacroX SI CHANGEMENT COLONNE 16 LIGNE 68 PUIS CHANGEMENT DE LIGNES PUIS CHANGEMENT DE COLONNES

'If Target.Count > 1 Then Exit Sub
For A = 8 To 173 Step 15
'If Target.Address = "Union(Range(Cells(68, A + 1), Cells(102, A + 1)), Range(Cells(68, A + 8), Cells(102, A + 8)))" Then
If Not Intersect(Target, Union(Range(Cells(68, A + 1), Cells(102, A + 1)).Dependents, Range(Cells(68, A + 8), Cells(102, A + 8)))) Is Nothing Then

 'LIG = Target.Offset(0, 0).Rows
 B = Target.Offset.Row
 Cells(B, A + 10).ClearContents

'Call MACROVERR
'If Cell <> "" Then
    If Weekday(Now, 2) < 6 Then
    DA = Date
     ElseIf Weekday(Now, 2) = 7 Then
     DA = Date + 2
      ElseIf Weekday(Now, 2) = 1 Then
      DA = Date + 1
    End If

        dateDeb = DA: duree2 = Cells(21, 2): duree1 = Cells(20, 2)
        dateFin1 = Application.WorkDay(dateDeb, duree1)
        dateFin2 = Application.WorkDay(dateDeb, duree2)

            If Cells(B, A) < DA + Cells(21, 2) And Cells(B, A) <> "" Then 'SI DATE MACRO < DATE DU JOUR + B21 (7) ET DATE MACRO n'est pas vide
            Cells(B, A + 9) = "X" 'VERR DATE = X
             ElseIf Cells(B, A + 10) < DA + Cells(20, 2) And Cells(B, A + 10) <> "" Then 'Si DATE PROD < DATE DU JOUR + B20 (3) ET DATE PROD n'est pas vide
             Cells(B, A + 9) = "X" 'VERR DATE = X
              Else: Cells(B, A + 9) = "" 'SI TOUT EST FAUX VERR DATE = ""
            End If

'Call MacroX
                If Weekday(Now, 2) < 6 Then
                 DA = Date
                  ElseIf Weekday(Now, 2) = 7 Then
                  DA = Date + 2
                   ElseIf Weekday(Now, 2) = 1 Then
                   DA = Date + 1
                End If

                        dateDeb = DA: duree2 = Cells(21, 2): duree1 = Cells(20, 2)
                        dateFin1 = Application.WorkDay(dateDeb, duree1)
                        dateFin2 = Application.WorkDay(dateDeb, duree2)

                        If Cells(B, A + 8) > DA + Cells(21, 2) And Cells(B, A + 8) <> "" And Cells(B, A + 10) <> "" And Cells(B, A + 10) <= Cells(B, A + 8) Then 'SI DATE DE LIV DEF > DATE DU JOUR + B21(7) ET DATE DE LIV DEF <> "" AND DATE PROD <> "" ET DATE PROD <= DATE DE LIV DEF
                        Cells(B, A + 7) = dateFin2 'SI VRAI DATE DE LIV POSSIBLE = DATE DU JOUR + B21(7) + X JOUR POUR AVOIR UN JOUR OUVRE
                         ElseIf Cells(B, A + 8) = "" Then 'SI FAUX SI DATE DE LIV DEF = ""
                         Cells(B, A + 7) = "" 'SI VRAI DATE DE LIV POSSIBLE = ""
                          ElseIf Cells(B, A + 8) > dateFin2 Then 'SI FAUX SI DATE DE LIV DEF > DATE DU JOUR + B21(7) + X JOUR POUR AVOIR UN JOUR OUVRE
                          Cells(B, A + 7) = Cells(B, A + 8) 'SI VRAI DATE DE LIV POSSIBLE = DATE DE LIV DEF
                           Else: Cells(B, A + 7) = dateFin1 'SI TOUT EST FAUX DATE DE LIV POSSIBLE = DATE DU JOUR + B20(3) + X JOUR POUR AVOIR UN JOUR OUVRE
                        End If
                            If Cells(B, A + 8) <> "" And Cells(B, A + 7) <> "X" Then 'SI DATE DE LIV DEF <> "" ET VERR. DATE <> X
                                If Weekday(Cells(B, A + 7), 2) < 6 And Cells(B, A + 8) > dateFin2 Then 'SI VRAI
                                Cells(B, A + 7) = Cells(B, A + 8)
                                 ElseIf Weekday(Cells(B, A + 7), 2) = 6 Then
                                 Cells(B, A + 7) = Cells(B, A + 7) + 2
                                  ElseIf Weekday(Cells(B, A + 7), 2) = 7 Then
                                  Cells(B, A + 7) = Cells(B, A + 7) + 1
                                   Else: Cells(B, A + 7) = dateFin2
                                End If
                            End If

'Call MACROVERR
                                    If Weekday(Now, 2) < 6 Then
                                    DA = Date
                                     ElseIf Weekday(Now, 2) = 7 Then
                                     DA = Date + 2
                                      ElseIf Weekday(Now, 2) = 1 Then
                                      DA = Date + 1
                                    End If

                                        dateDeb = DA: duree2 = Cells(21, 2): duree1 = Cells(20, 2)
                                        dateFin1 = Application.WorkDay(dateDeb, duree1)
                                        dateFin2 = Application.WorkDay(dateDeb, duree2)

                                        If Cells(B, A) < DA + Cells(21, 2) And Cells(B, A) <> "" Then 'SI DATE MACRO < DATE DU JOUR + B21 (7) ET DATE MACRO n'est pas vide
                                        Cells(B, A + 9) = "X" 'VERR DATE = X
                                         ElseIf Cells(B, A + 10) < DA + Cells(20, 2) And Cells(B, A + 10) <> "" Then 'Si DATE PROD < DATE DU JOUR + B20 (3) ET DATE PROD n'est pas vide
                                         Cells(B, A + 9) = "X" 'VERR DATE = X
                                          Else: Cells(B, A + 9) = "" 'SI TOUT EST FAUX VERR DATE = ""
                                        End If

'Call DATEMACRO OK!
                                            If Cells(B, A + 8) <> "" And Cells(B, A + 9) <> "X" And Cells(B, A + 12) = "" Then 'SI DATE DE LIV DEF <> "" ET VERR. DATE <> X ET DATE DE LIVR FORCEE = ""
                                            Cells(B, A) = Cells(B, A + 7)
                                            Cells(B, A + 10) = "" 'SI VRAI DATES MACRO = DATE DE LIV POSSIBLE 'SI VRAI EFFACER DATE PROD POUR REGENERER LA DATE DU PLANING
                                             ElseIf Cells(B, A + 8) <> "" And Cells(B, A + 9) = "X" And Cells(B, C + 4) = "" Then 'SI FAUX DATE DE LIV DEF <> "" ET VERR. DATE = X ET DATE LIVR FORCEE = ""
                                             Cells(B, A) = Cells(B, A + 1) 'SI VRAI DATES MACRO = DATES PREVISIONNEL
                                             'MsgBox "ATTENTION DATE VERROUILLEE ! SI VOUS SOUHAITEZ LA CHANGER MERCI D'INSCRIRE LA NOUVELLE DATE DANS LA COLONNE DATE DE LIVRAISON FORCEE"
                                              ElseIf Cells(B, A + 12) <> "" Then 'SI FAUX DATE LIVR FORCEE <> ""
                                              Cells(B, A) = Cells(B, A + 12)
                                              Cells(B, A + 10) = "" 'SI VRAI DATES MACRO = DATE LIVR FORCEE 'SI VRAI EFFACER DATE PROD POUR REGENERER LA DATE DU PLANING
                                               Else: Cells(B, A) = Cells(B, A + 1) 'SI TOUT FAUX DATES MACRO = DATES PREVISIONNEL
                                            End If

End If
 Next A

'LANCEMENT MacroCAL SI CHANGEMENT DE PRIX / TUBES OU NB DE LOGEMENT
If Not Intersect(Target, Range("I25:GD61,B139:O153")) Is Nothing Then
End If
Call MACASS
Call MACARDC
Call MACAETA
Call MACTUBSS
Call MACTUBRDC
Call MACTUBETA
Call MacroNomEtag

Line1:
End If
Application.EnableEvents = True
End Sub

mon problème se situe 4 lignes après

18synoptique-v3.zip (303.35 Ko)
'LANCEMENT MacroX SI CHANGEMENT COLONNE 16 LIGNE 68 PUIS CHANGEMENT DE LIGNES PUIS CHANGEMENT DE COLONNES
Le 08/12/2022 à 11:18

Bonjour,

si je lis l'aide :
Renvoie un objet Range qui représente la plage contenant tous les dépendants d’une cellule.
Boucle pour les récupérer cellule par cellule.
eric

Le 08/12/2022 à 11:20

J'ai peut-être une solution en rajoutant juste après:

If Not Intersect(Target, Union(Range(Cells(68, A + 1), Cells(102, A + 1)).Dependents, Range(Cells(68, A + 8), Cells(102, A + 8)))) Is Nothing Then

.....:

If Target.Offset.Row < 68 Then
 B = Target.Offset.Row + 41
 Cells(B, A + 10).ClearContents
 ElseIf B = Target.Offset.Row Then
 Cells(B, A + 10).ClearContents

ce qui donne :

Sub Worksheet_Change(ByVal Target As Range)

Dim A, B, C As Variant
Dim DA As Variant
Dim dateDeb As Date, dateFin1 As Date, dateFin2 As Date, duree1 As Long, duree2 As Long

Debug.Print Target.Address
Debug.Print Target.Offset.Row

Application.EnableEvents = False
If ToggleButton1 = True Then
GoTo Line1
Else: GoTo Line2

Line2:

'LARGEURS DES CELLULES AUTOMATIQUEMENT
  With Target.CurrentRegion
    Target.CurrentRegion.EntireColumn.AutoFit

 'MASQUAGE DES COLONNES / NB DE BÂTIMENT

   If Target.Address = "$B$16" Then 'Après chaque modification de la cellule B16
   'Affiche toutes les colonnes déjà masquées dans la feuille Cible
      With Sheets(ActiveSheet.Name)
          .Cells.EntireColumn.Hidden = False
      'Masque les colonnes en fonction de la valeur de B12
         Select Case Range("B16").Value
            Case ""
               .Columns("H:GF").EntireColumn.Hidden = True
            Case "1"
               .Columns("v:GF").EntireColumn.Hidden = True
            Case "2"
               .Columns("AK:GF").EntireColumn.Hidden = True
            Case "3"
               .Columns("AZ:GF").EntireColumn.Hidden = True
            Case "4"
               .Columns("BO:GF").EntireColumn.Hidden = True
            Case "5"
               .Columns("CD:GF").EntireColumn.Hidden = True
            Case "6"
               .Columns("CS:GF").EntireColumn.Hidden = True
            Case "7"
               .Columns("DH:GF").EntireColumn.Hidden = True
            Case "8"
               .Columns("DW:GF").EntireColumn.Hidden = True
            Case "9"
               .Columns("EL:GF").EntireColumn.Hidden = True
            Case "10"
               .Columns("FA:GF").EntireColumn.Hidden = True
            Case "11"
               .Columns("FP:GF").EntireColumn.Hidden = True

        End Select
    End With

  End If
End With

'LANCEMENT MacroX SI CHANGEMENT COLONNE 16 LIGNE 68 PUIS CHANGEMENT DE LIGNES PUIS CHANGEMENT DE COLONNES

'If Target.Count > 1 Then Exit Sub
For A = 8 To 173 Step 15
'If Target.Address = "Union(Range(Cells(68, A + 1), Cells(102, A + 1)), Range(Cells(68, A + 8), Cells(102, A + 8)))" Then
If Not Intersect(Target, Union(Range(Cells(68, A + 1), Cells(102, A + 1)).Dependents, Range(Cells(68, A + 8), Cells(102, A + 8)))) Is Nothing Then
 If Target.Offset.Row < 68 Then
 B = Target.Offset.Row + 41
 Cells(B, A + 10).ClearContents
 ElseIf B = Target.Offset.Row Then
 Cells(B, A + 10).ClearContents

'Call MACROVERR
'If Cell <> "" Then
    If Weekday(Now, 2) < 6 Then
    DA = Date
     ElseIf Weekday(Now, 2) = 7 Then
     DA = Date + 2
      ElseIf Weekday(Now, 2) = 1 Then
      DA = Date + 1
    End If

        dateDeb = DA: duree2 = Cells(21, 2): duree1 = Cells(20, 2)
        dateFin1 = Application.WorkDay(dateDeb, duree1)
        dateFin2 = Application.WorkDay(dateDeb, duree2)

            If Cells(B, A) < DA + Cells(21, 2) And Cells(B, A) <> "" Then 'SI DATE MACRO < DATE DU JOUR + B21 (7) ET DATE MACRO n'est pas vide
            Cells(B, A + 9) = "X" 'VERR DATE = X
             ElseIf Cells(B, A + 10) < DA + Cells(20, 2) And Cells(B, A + 10) <> "" Then 'Si DATE PROD < DATE DU JOUR + B20 (3) ET DATE PROD n'est pas vide
             Cells(B, A + 9) = "X" 'VERR DATE = X
              Else: Cells(B, A + 9) = "" 'SI TOUT EST FAUX VERR DATE = ""
            End If

'Call MacroX
                If Weekday(Now, 2) < 6 Then
                 DA = Date
                  ElseIf Weekday(Now, 2) = 7 Then
                  DA = Date + 2
                   ElseIf Weekday(Now, 2) = 1 Then
                   DA = Date + 1
                End If

                        dateDeb = DA: duree2 = Cells(21, 2): duree1 = Cells(20, 2)
                        dateFin1 = Application.WorkDay(dateDeb, duree1)
                        dateFin2 = Application.WorkDay(dateDeb, duree2)

                        If Cells(B, A + 8) > DA + Cells(21, 2) And Cells(B, A + 8) <> "" And Cells(B, A + 10) <> "" And Cells(B, A + 10) <= Cells(B, A + 8) Then 'SI DATE DE LIV DEF > DATE DU JOUR + B21(7) ET DATE DE LIV DEF <> "" AND DATE PROD <> "" ET DATE PROD <= DATE DE LIV DEF
                        Cells(B, A + 7) = dateFin2 'SI VRAI DATE DE LIV POSSIBLE = DATE DU JOUR + B21(7) + X JOUR POUR AVOIR UN JOUR OUVRE
                         ElseIf Cells(B, A + 8) = "" Then 'SI FAUX SI DATE DE LIV DEF = ""
                         Cells(B, A + 7) = "" 'SI VRAI DATE DE LIV POSSIBLE = ""
                          ElseIf Cells(B, A + 8) > dateFin2 Then 'SI FAUX SI DATE DE LIV DEF > DATE DU JOUR + B21(7) + X JOUR POUR AVOIR UN JOUR OUVRE
                          Cells(B, A + 7) = Cells(B, A + 8) 'SI VRAI DATE DE LIV POSSIBLE = DATE DE LIV DEF
                           Else: Cells(B, A + 7) = dateFin1 'SI TOUT EST FAUX DATE DE LIV POSSIBLE = DATE DU JOUR + B20(3) + X JOUR POUR AVOIR UN JOUR OUVRE
                        End If
                            If Cells(B, A + 8) <> "" And Cells(B, A + 7) <> "X" Then 'SI DATE DE LIV DEF <> "" ET VERR. DATE <> X
                                If Weekday(Cells(B, A + 7), 2) < 6 And Cells(B, A + 8) > dateFin2 Then 'SI VRAI
                                Cells(B, A + 7) = Cells(B, A + 8)
                                 ElseIf Weekday(Cells(B, A + 7), 2) = 6 Then
                                 Cells(B, A + 7) = Cells(B, A + 7) + 2
                                  ElseIf Weekday(Cells(B, A + 7), 2) = 7 Then
                                  Cells(B, A + 7) = Cells(B, A + 7) + 1
                                   Else: Cells(B, A + 7) = dateFin2
                                End If
                            End If

'Call MACROVERR
                                    If Weekday(Now, 2) < 6 Then
                                    DA = Date
                                     ElseIf Weekday(Now, 2) = 7 Then
                                     DA = Date + 2
                                      ElseIf Weekday(Now, 2) = 1 Then
                                      DA = Date + 1
                                    End If

                                        dateDeb = DA: duree2 = Cells(21, 2): duree1 = Cells(20, 2)
                                        dateFin1 = Application.WorkDay(dateDeb, duree1)
                                        dateFin2 = Application.WorkDay(dateDeb, duree2)

                                        If Cells(B, A) < DA + Cells(21, 2) And Cells(B, A) <> "" Then 'SI DATE MACRO < DATE DU JOUR + B21 (7) ET DATE MACRO n'est pas vide
                                        Cells(B, A + 9) = "X" 'VERR DATE = X
                                         ElseIf Cells(B, A + 10) < DA + Cells(20, 2) And Cells(B, A + 10) <> "" Then 'Si DATE PROD < DATE DU JOUR + B20 (3) ET DATE PROD n'est pas vide
                                         Cells(B, A + 9) = "X" 'VERR DATE = X
                                          Else: Cells(B, A + 9) = "" 'SI TOUT EST FAUX VERR DATE = ""
                                        End If

'Call DATEMACRO OK!
                                            If Cells(B, A + 8) <> "" And Cells(B, A + 9) <> "X" And Cells(B, A + 12) = "" Then 'SI DATE DE LIV DEF <> "" ET VERR. DATE <> X ET DATE DE LIVR FORCEE = ""
                                            Cells(B, A) = Cells(B, A + 7)
                                            Cells(B, A + 10) = "" 'SI VRAI DATES MACRO = DATE DE LIV POSSIBLE 'SI VRAI EFFACER DATE PROD POUR REGENERER LA DATE DU PLANING
                                             ElseIf Cells(B, A + 8) <> "" And Cells(B, A + 9) = "X" And Cells(B, C + 4) = "" Then 'SI FAUX DATE DE LIV DEF <> "" ET VERR. DATE = X ET DATE LIVR FORCEE = ""
                                             Cells(B, A) = Cells(B, A + 1) 'SI VRAI DATES MACRO = DATES PREVISIONNEL
                                             'MsgBox "ATTENTION DATE VERROUILLEE ! SI VOUS SOUHAITEZ LA CHANGER MERCI D'INSCRIRE LA NOUVELLE DATE DANS LA COLONNE DATE DE LIVRAISON FORCEE"
                                              ElseIf Cells(B, A + 12) <> "" Then 'SI FAUX DATE LIVR FORCEE <> ""
                                              Cells(B, A) = Cells(B, A + 12)
                                              Cells(B, A + 10) = "" 'SI VRAI DATES MACRO = DATE LIVR FORCEE 'SI VRAI EFFACER DATE PROD POUR REGENERER LA DATE DU PLANING
                                               Else: Cells(B, A) = Cells(B, A + 1) 'SI TOUT FAUX DATES MACRO = DATES PREVISIONNEL
                                            End If

 End If
End If
 Next A

'LANCEMENT MacroCAL SI CHANGEMENT DE PRIX / TUBES OU NB DE LOGEMENT
If Not Intersect(Target, Range("I25:GD61,B139:O153")) Is Nothing Then
End If
Call MACASS
Call MACARDC
Call MACAETA
Call MACTUBSS
Call MACTUBRDC
Call MACTUBETA
Call MacroNomEtag

Line1:
End If
Application.EnableEvents = True
End Sub

Mais malheureusement ça ne fonctionne pas.....

Le 08/12/2022 à 12:06

As-tu vu mon post au-dessus ?

Le 08/12/2022 à 12:09

Alors j'ai essayé ca mais malheureusement il n'execute toujours pas si je change la cellule qui modifie la cellule dans la Target...

For A = 8 To 173 Step 15
'If Target.Address = "Union(Range(Cells(68, A + 1), Cells(102, A + 1)), Range(Cells(68, A + 8), Cells(102, A + 8)))" Then
If Not Intersect(Target, Union(Range(Cells(68, A + 1), Cells(102, A + 1)).Dependents, Range(Cells(68, A + 8), Cells(102, A + 8)))) Is Nothing Then
B = Target.Offset.Row
 If Target.Offset.Row < 68 Then
 B = B + 41
 Else: B = B
 Cells(B, A + 10).ClearContents

Bonjour Eric et merci pour votre aide !

J'essaye de comprendre votre remarque mais j'avoue que je ne vois pas trop sur quoi doit être fais la boucle...

Merci encore

Le 08/12/2022 à 12:37
Si .Dependents n'est prévu que pour une cellule unique tu dois rechercher les dépendants pour chaque cellule de Union(Range(Cells(68, A + 1), Cells(102, A + 1)) et en faire l'union
Du style :
For each c in Union(Range(Cells(68, A + 1), Cells(102, A + 1))
'ajouter dépendants cellule suivante
Next c
Le 08/12/2022 à 15:07

Merci Eric, j'ai essayé... j'ai bien compris qu'il fallait vérifier chaque cellule de la Range.dependants (For each C) mais par contre j'ai du mal avec la syntaxe pour réintégrer par la suite cette variable C dans le If Not Intersect...

Pour l'instant j'ai essayé ça mais biensure pas de resultat le "INTERSECT" ne fonctionne plus et donc tout le reste des macros...

For A = 8 To 173 Step 15

For Each C In Union(Cells(68, A + 1), Cells(102, A + 1)).Dependents

If Not Intersect(Target, Union(C, Range(Cells(68, A + 8), Cells(102, A + 8)))) Is Nothing Then
B = Target.Offset.Row
 If Target.Offset.Row < 68 Then
 B = B + 41
 Else: B = B
 Cells(B, A + 10).ClearContents

A l'aide s'il vous plais !!!

Le 08/12/2022 à 19:31

J'ai du mal à suivre ton blougi-goulba...

Je voyaisça ainsi :

' boucle recup Dependents
    Dim pl2 As Range, c As Range
    For Each c In Range(Cells(68, A + 1), Cells(102, A + 1))
        ' on récupère les Dependents d'une cellule
        On Error Resume Next
        If pl2 Is Nothing Then
            Set pl2 = c.Dependents
        Else
            Set pl2 = Union(pl2, c.Dependents)
        End If
        On Error GoTo 0
    Next c
    ' on fabrique le Range final en évitant les erreurs si Dependents vides
    If pl2 Is Nothing Then
        Set pl2 = Range(Cells(68, A + 8), Cells(102, A + 8))
    Else
        Set pl2 = Union(pl2, Range(Cells(68, A + 8), Cells(102, A + 8)))
    End If
    ' ta ligne devient
    'If Not Intersect(Target, Union(Range(Cells(68, A + 1), Cells(102, A + 1)).Dependents, Range(Cells(68, A + 8), Cells(102, A + 8)))) Is Nothing Then
    If Not Intersect(target, pl2) Is Nothing Then

Non, testé ! à toi de tester en pas à pas et en contrôlant que le résultat est correct dans les variables

je t'ai mis les traitements d'erreur.
Si tu es sûr à 100% que TOUTES les cellules auront des Dependents tu peux compacter ainsi :

' boucle recup Dependents
    Dim pl2 As Range, c As Range
    For Each c In Range(Cells(68, A + 1), Cells(102, A + 1))
        ' on récupère les Dependents d'une cellule
        If pl2 Is Nothing Then Set pl2 = c.Dependents Else Set pl2 = Union(pl2, c.Dependents)
    Next c
    ' on fabrique le Range final
    Set pl2 = Union(pl2, Range(Cells(68, A + 8), Cells(102, A + 8)))
    ' ta ligne devient
    'If Not Intersect(Target, Union(Range(Cells(68, A + 1), Cells(102, A + 1)).Dependents, Range(Cells(68, A + 8), Cells(102, A + 8)))) Is Nothing Then
    If Not Intersect(target, pl2) Is Nothing Then

eric

Rechercher des sujets similaires à "fonction dependants union range"