Contrôle des valeurs sur Private Sub Worksheet_Change(ByVal Target As Range)

[Youri]

Bonjour,

Comment s'assurer que la valeur de Target dans Private Sub Worksheet_Change(ByVal Target As Range) est différente de la valeur existant précédemment dans la cellule ?
Je précise: Si par exemple la cellule A1 contient 1 et qu'on veut effacer le contenu de la cellule B1 si A1 est différente de 1, comment faire pour ne pas effacer le contenu de B1 si on entre à nouveau 1 dans A1 ?

Je vous remercie à l'avance,
Youri

 

[Robert]

Re : Contrôle des valeurs sur Private Sub Worksheet_Change(ByVal Target As Range)

Bonjour Youri, bonjour le forum,

Un peu tiré par les cheveux... Je te propose une méthode qui par SelectionChange permet de récupérer la valeur avant changement, puis après l'édition par Change, provoque l'effacement de B1 selon que la valeur éditée en A1 est différente ou pas.

 

[Youri]

Re : Contrôle des valeurs sur Private Sub Worksheet_Change(ByVal Target As Range)

Bonjour Robert,

Merci d'avoir répondu à mon problème, je n'avais pas pensé à cette solution.
J'ai un peu amélioré les performances de la macro. Elle se trouve ci-jointe.
J'ai par ailleurs remarqué que déclarer la variable en string était plus lent qu'en variant.

Voilà, merci encore une fois et bonne journée.
Youri

Ps : J'ai encore modifié la macro (tant qu'on y est, pourquoi ne pas simplifier ?) heure dernière modif : 18h00

 

[Youri]

Re : Contrôle des valeurs sur Private Sub Worksheet_Change(ByVal Target As Range)

Je viens de remarquer un bug : si on sélectionne 2 cellules et qu'on appuie sur suppr, ça bug. Est-ce que quelqu'un a une idée ?

Merci à l'avance,
Youri

 

[bqtr]

Re : Contrôle des valeurs sur Private Sub Worksheet_Change(ByVal Target As Range)

Bonjour Youri, Robert, le forum

Essaye avec ce code, s'il y a plus d'une cellule sélectionnée, la procédure est désactivée.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Address = "$A$1" And Target.Value <> va Then Target.Offset(1, 0).ClearContents
End Sub

Bonne soirée

 

[Youri]

Re : Contrôle des valeurs sur Private Sub Worksheet_Change(ByVal Target As Range)

Bonjour Pierre Olivier,

Merci pour le coup de main mais je m'en suis sorti avec "On Error Resume Next", On Error GoTo 0 et une condition supplémentaire ce qui m'a permis de quand même effacer les données si jamais la cellule A1 fait partie de la sélection. D'ailleurs, j'ai essayé de reproduire le même comportement dans une autre feuille et ça marche pas. Avis aux amateurs : voici le code :

Private preceffA As Variant
Private preceffB As Variant
Private preceffC As Variant
Private preceffD As Variant
Private preceffE As Variant
Private preceffF As Variant
Private preceffG As Variant
Private preceffH As Variant
Private preceffI As Variant
Private preceffJ As Variant
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$C$207" Then preceffA = Target.Value
If Target.Address = "$F$207" Then preceffB = Target.Value
If Target.Address = "$C$234" Then preceffC = Target.Value
If Target.Address = "$F$234" Then preceffD = Target.Value
If Target.Address = "$C$261" Then preceffE = Target.Value
If Target.Address = "$F$261" Then preceffF = Target.Value
If Target.Address = "$C$288" Then preceffG = Target.Value
If Target.Address = "$F$288" Then preceffH = Target.Value
If Target.Address = "$C$315" Then preceffI = Target.Value
If Target.Address = "$F$315" Then preceffJ = Target.Value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim celA As Range
Dim comptA As Byte
Dim celB As Range
Dim comptB As Byte
Dim celC As Range
Dim comptC As Byte
Dim celD As Range
Dim comptD As Byte
Dim celE As Range
Dim comptE As Byte
Dim celF As Range
Dim comptF As Byte
Dim celG As Range
Dim comptG As Byte
Dim celH As Range
Dim comptH As Byte
Dim celI As Range
Dim comptI As Byte
Dim CellConc As Range
Dim Plage As Range
Dim TempConcatenation As String
Dim CellConc2 As Range
Dim Plage2 As Range
Dim TempConcatenation2 As String
Dim CellConc3 As Range
Dim Plage3 As Range
Dim TempConcatenation3 As String
Dim CellConc4 As Range
Dim Plage4 As Range
Dim TempConcatenation4 As String
Dim CellConc5 As Range
Dim Plage5 As Range
Dim TempConcatenation5 As String
Dim CelleffA As Range
Dim PlageeffA As Range
Dim CelleffB As Range
Dim PlageeffB As Range
Dim CelleffC As Range
Dim PlageeffC As Range
Dim CelleffD As Range
Dim PlageeffD As Range
Dim CelleffE As Range
Dim PlageeffE As Range
Dim CelleffF As Range
Dim PlageeffF As Range
Dim CelleffG As Range
Dim PlageeffG As Range
Dim CelleffH As Range
Dim PlageeffH As Range
Dim CelleffI As Range
Dim PlageeffI As Range
Dim CelleffJ As Range
Dim PlageeffJ As Range
With Worksheets("Fiche de renseignements")
    On Error Resume Next
    If Target.Address = "$C$207" And Target.Value <> preceffA Then
    If Target.Address = "$C$207" Then
    Set PlageeffA = Range("C208:C231")
        For Each CelleffA In PlageeffA
            If CelleffA.Value <> 0 And CelleffA.Value <> "" Then
                CelleffA.ClearContents
            End If
        Next
    End If
    End If
    If Target.Address = "$F$207" And Target.Value <> preceffB Then
    If Target.Address = "$F$207" Then
    Set PlageeffB = Range("F208:F231")
        For Each CelleffB In PlageeffB
            If CelleffB.Value <> 0 And CelleffB.Value <> "" Then
                CelleffB.ClearContents
            End If
        Next
    End If
    End If
    If Target.Address = "$C$234" And Target.Value <> preceffC Then
    If Target.Address = "$C$234" Then
    Set PlageeffC = Range("C235:C258")
        For Each CelleffC In PlageeffC
            If CelleffC.Value <> 0 And CelleffC.Value <> "" Then
                CelleffC.ClearContents
            End If
        Next
    End If
    End If
    If Target.Address = "$F$234" And Target.Value <> preceffD Then
    If Target.Address = "$F$234" Then
    Set PlageeffD = Range("F235:F258")
        For Each CelleffD In PlageeffD
            If CelleffD.Value <> 0 And CelleffD.Value <> "" Then
                CelleffD.ClearContents
            End If
        Next
    End If
    End If
    If Target.Address = "$C$261" And Target.Value <> preceffE Then
    If Target.Address = "$C$261" Then
    Set PlageeffE = Range("C262:C285")
        For Each CelleffE In PlageeffE
            If CelleffE.Value <> 0 And CelleffE.Value <> "" Then
                CelleffE.ClearContents
            End If
        Next
    End If
    End If
    If Target.Address = "$F$261" And Target.Value <> preceffF Then
    If Target.Address = "$F$261" Then
    Set PlageeffF = Range("F262:F285")
        For Each CelleffF In PlageeffF
            If CelleffF.Value <> 0 And CelleffF.Value <> "" Then
                CelleffF.ClearContents
            End If
        Next
    End If
    End If
    If Target.Address = "$C$288" And Target.Value <> preceffG Then
    If Target.Address = "$C$288" Then
    Set PlageeffG = Range("C289:C312")
        For Each CelleffG In PlageeffG
            If CelleffG.Value <> 0 And CelleffG.Value <> "" Then
                CelleffG.ClearContents
            End If
        Next
    End If
    End If
    If Target.Address = "$F$288" And Target.Value <> preceffH Then
    If Target.Address = "$F$288" Then
    Set PlageeffH = Range("F289:F312")
        For Each CelleffH In PlageeffH
            If CelleffH.Value <> 0 And CelleffH.Value <> "" Then
                CelleffH.ClearContents
            End If
        Next
    End If
    End If
    If Target.Address = "$C$315" And Target.Value <> preceffI Then
    If Target.Address = "$C$315" Then
    Set PlageeffI = Range("C316:C339")
        For Each CelleffI In PlageeffI
            If CelleffI.Value <> 0 And CelleffI.Value <> "" Then
                CelleffI.ClearContents
            End If
        Next
    End If
    End If
    If Target.Address = "$F$315" And Target.Value <> preceffJ Then
    If Target.Address = "$F$315" Then
    Set PlageeffJ = Range("F316:F339")
        For Each CelleffJ In PlageeffJ
            If CelleffJ.Value <> 0 And CelleffJ.Value <> "" Then
                CelleffJ.ClearContents
            End If
        Next
    End If
    End If
    On Error GoTo 0
End With
    For Each celA In Range("F47:F59")
        If celA <> "" And celA <> 0 Then
           comptA = comptA + 1
        End If
    Next
    If comptA > 0 Then
        If Range("F60:F74").EntireRow.Hidden = True Then
            Range("F60:F74").EntireRow.Hidden = False
        End If
        Else
        If Range("F60:F74").EntireRow.Hidden = False Then
            Range("F60:F74").EntireRow.Hidden = True
        End If
    End If
    For Each celB In Range("F62:F74")
        If celB <> "" And celB <> 0 Then
           comptB = comptB + 1
        End If
    Next
    If comptB > 0 Then
        If Range("F75:F89").EntireRow.Hidden = True Then
            Range("F75:F89").EntireRow.Hidden = False
        End If
        Else
        If Range("F75:F89").EntireRow.Hidden = False Then
            Range("F75:F89").EntireRow.Hidden = True
        End If
    End If
    For Each celC In Range("F77:F89")
        If celC <> "" And celC <> 0 Then
           comptC = comptC + 1
        End If
    Next
    If comptC > 0 Then
        If Range("F90:F104").EntireRow.Hidden = True Then
            Range("F90:F104").EntireRow.Hidden = False
        End If
        Else
        If Range("F90:F104").EntireRow.Hidden = False Then
            Range("F90:F104").EntireRow.Hidden = True
        End If
    End If

Bonne journée,
Youri

 

[Youri]

Re : Contrôle des valeurs sur Private Sub Worksheet_Change(ByVal Target As Range)

Et la suite :

    For Each celD In Range("F130:F137")
        If celD <> "" And celD <> 0 Then
           comptD = comptD + 1
        End If
    Next
    If comptD > 0 Then
        If Range("F138:F147").EntireRow.Hidden = True Then
            Range("F138:F147").EntireRow.Hidden = False
        End If
        Else
        If Range("F138:F147").EntireRow.Hidden = False Then
            Range("F138:F147").EntireRow.Hidden = True
        End If
    End If
    For Each celE In Range("F120:F127")
        If celE <> "" And celE <> 0 Then
           comptE = comptE + 1
        End If
    Next
    If comptE > 0 Then
        If Range("F128:F137").EntireRow.Hidden = True Then
            Range("F128:F137").EntireRow.Hidden = False
        End If
        Else
        If Range("F128:F137").EntireRow.Hidden = False Then
            Range("F128:F137").EntireRow.Hidden = True
        End If
    End If
    For Each celF In Range("F110:F117")
        If celF <> "" And celF <> 0 Then
           comptF = comptF + 1
        End If
    Next
    If comptF > 0 Then
        If Range("F118:F127").EntireRow.Hidden = True Then
            Range("F118:F127").EntireRow.Hidden = False
        End If
        Else
        If Range("F118:F127").EntireRow.Hidden = False Then
            Range("F118:F127").EntireRow.Hidden = True
        End If
    End If
    For Each celG In Range("F177:F186")
        If celG <> "" And celG <> 0 Then
           comptG = comptG + 1
        End If
    Next
    If comptG > 0 Then
        If Range("F187:F198").EntireRow.Hidden = True Then
            Range("F187:F198").EntireRow.Hidden = False
        End If
        Else
        If Range("F187:F198").EntireRow.Hidden = False Then
            Range("F187:F198").EntireRow.Hidden = True
        End If
    End If
    For Each celH In Range("F165:F174")
        If celH <> "" And celH <> 0 Then
           comptH = comptH + 1
        End If
    Next
    If comptH > 0 Then
        If Range("F175:F186").EntireRow.Hidden = True Then
            Range("F175:F186").EntireRow.Hidden = False
        End If
        Else
        If Range("F175:F186").EntireRow.Hidden = False Then
            Range("F175:F186").EntireRow.Hidden = True
        End If
    End If
    For Each celI In Range("F153:F162")
        If celI <> "" And celI <> 0 Then
           comptI = comptI + 1
        End If
    Next
    If comptI > 0 Then
        If Range("F163:F174").EntireRow.Hidden = True Then
            Range("F163:F174").EntireRow.Hidden = False
        End If
        Else
        If Range("F163:F174").EntireRow.Hidden = False Then
            Range("F163:F174").EntireRow.Hidden = True
        End If
    End If
If Worksheets("Fiche de renseignements").Range("F207") <> 0 And Worksheets("Fiche de renseignements").Range("F207") <> "" Then
    If Range("F232:F235").EntireRow.Hidden = True Then
        Range("F232:F235").EntireRow.Hidden = False
    End If
    ElseIf Range("F232:F259").EntireRow.Hidden = False Then
        Range("F232:F259").EntireRow.Hidden = True
End If
If Worksheets("Fiche de renseignements").Range("F234") <> 0 And Worksheets("Fiche de renseignements").Range("F234") <> "" Then
    If Range("F259:F262").EntireRow.Hidden = True Then
        Range("F259:F262").EntireRow.Hidden = False
    End If
    ElseIf Range("F259:F286").EntireRow.Hidden = False Then
        Range("F259:F286").EntireRow.Hidden = True
End If
If Worksheets("Fiche de renseignements").Range("F261") <> 0 And Worksheets("Fiche de renseignements").Range("F234") <> "" Then
    If Range("F286:F289").EntireRow.Hidden = True Then
        Range("F286:F289").EntireRow.Hidden = False
    End If
    ElseIf Range("F286:F313").EntireRow.Hidden = False Then
        Range("F286:F313").EntireRow.Hidden = True
End If
If Worksheets("Fiche de renseignements").Range("F288") <> 0 And Worksheets("Fiche de renseignements").Range("F234") <> "" Then
    If Range("F313:F316").EntireRow.Hidden = True Then
        Range("F313:F316").EntireRow.Hidden = False
    End If
    ElseIf Range("F313:F339").EntireRow.Hidden = False Then
        Range("F313:F339").EntireRow.Hidden = True
End If
With Sheets("Fiche de renseignements")
    Set Plage = .Range("B209:B" & .Range("B231").Row)
        For Each CellConc In Plage
        TempConcatenation = CellConc & CellConc.Offset(0, 3)
        If TempConcatenation = "" Then
            If .Rows(CellConc.Row).Hidden = False Then
                .Rows(CellConc.Row).Hidden = True
            End If
            ElseIf .Rows(CellConc.Row).Hidden = True Then
                .Rows(CellConc.Row).Hidden = False
        End If
        Next
End With
With Sheets("Fiche de renseignements")
    Set Plage2 = .Range("B236:B" & .Range("B258").Row)
        For Each CellConc2 In Plage2
        TempConcatenation2 = CellConc2 & CellConc2.Offset(0, 3)
        If TempConcatenation2 = "" Then
            If .Rows(CellConc2.Row).Hidden = False Then
                .Rows(CellConc2.Row).Hidden = True
            End If
            ElseIf .Rows(CellConc2.Row).Hidden = True Then
                .Rows(CellConc2.Row).Hidden = False
        End If
        Next
End With
With Sheets("Fiche de renseignements")
    Set Plage3 = .Range("B263:B" & .Range("B285").Row)
        For Each CellConc3 In Plage3
        TempConcatenation3 = CellConc3 & CellConc3.Offset(0, 3)
        If TempConcatenation3 = "" Then
            If .Rows(CellConc3.Row).Hidden = False Then
                .Rows(CellConc3.Row).Hidden = True
            End If
            ElseIf .Rows(CellConc3.Row).Hidden = True Then
                .Rows(CellConc3.Row).Hidden = False
        End If
        Next
End With
With Sheets("Fiche de renseignements")
    Set Plage4 = .Range("B290:B" & .Range("B312").Row)
        For Each CellConc4 In Plage4
        TempConcatenation4 = CellConc4 & CellConc4.Offset(0, 3)
        If TempConcatenation4 = "" Then
            If .Rows(CellConc4.Row).Hidden = False Then
                .Rows(CellConc4.Row).Hidden = True
            End If
            ElseIf .Rows(CellConc4.Row).Hidden = True Then
                .Rows(CellConc4.Row).Hidden = False
        End If
        Next
End With
With Sheets("Fiche de renseignements")
    Set Plage5 = .Range("B317:B" & .Range("B339").Row)
        For Each CellConc5 In Plage5
        TempConcatenation5 = CellConc5 & CellConc5.Offset(0, 3)
        If TempConcatenation5 = "" Then
            If .Rows(CellConc5.Row).Hidden = False Then
                .Rows(CellConc5.Row).Hidden = True
            End If
            ElseIf .Rows(CellConc5.Row).Hidden = True Then
                .Rows(CellConc5.Row).Hidden = False
        End If
        Next
End With
End Sub