Microsoft 365 Private Sub Worksheet_Change(ByVal Target As Range)

[pat66]

bonjour le forum,

Au secours !!
je cherche un peu d'aide car cette macro, qui doit être très mal rédigée, bloque et ferme Excel au moindre changement

Private Sub Worksheet_Change(ByVal Target As Range)
Worksheets("simulateur").Unprotect "toto"
Application.ScreenUpdating = False
Application.EnableEvents = False

If Not Intersect(Target, Me.Range("K4")) Is Nothing Then
Range("S6") = Range("Y50")
Range("F27").FormulaLocal = "=SIERREUR(RECHERCHEV(S6;A147:B162;2;Faux);""<10 ans"")"
End If

If Not Intersect(Target, Me.Range("S6")) Is Nothing Then
'Range("F27").FormulaLocal = "=SIERREUR(RECHERCHEV(S6;A147:B162;2;Faux);""<10 ans"")"
'End If

If Not Intersect(Target, Me.Range("Y6")) Is Nothing Then
Range("F27").FormulaLocal = "=SIERREUR(RECHERCHEV(S6;A147:B162;2;Faux);""<10 ans"")"
End If

If Not Intersect(Target, Me.Range("F27")) Is Nothing Then
If Range("F27").Value < FormulaLocal = "=SIERREUR(RECHERCHEV(S6;A147:B162;2;Faux);""<10 ans"")" Then
MsgBox "Attention ! " & Chr(10) & Chr(10) & "Le résultat saisit est inférieur à " & Range("B162").Value & " €, vbInformation + vbOKOnly
Else
If Range("S6").Value <> Range("Q49").Value Then
MsgBox "Attention ! " & Chr(10) & Chr(10) & "Ce montant ne correspond pas, vbInformation + vbOKOnly
End If
End If
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
Worksheets("simulateur").protect "toto"
End Sub

 

[patricktoulon]

re

bonjour
la bonne blague
c'est une histoire sans fin tron truc
au change de "S" tu modifie F27
au dans le même event change tu fait une modif F7
ca tourne en rond ton truc
desactive les event pendant le code et reactive à la fin

et cela ne veux rien dire

If Range("F27").Value < FormulaLocal = "=SIERREUR(RECHERCHEV(S6;A147:B162;2;Faux);""<10 ans"")" Then

tu test si la valeur est plus petite que le string de la formule

bref tout à refaire

 

[pat66]

Bonjour patricktoulon,

merci du conseil,

tout ça parce que je pensais pouvoir faire en sorte que F27 est 2 fonctions, à savoir :
- soit contienne en permanence =SIERREUR(RECHERCHEV(S6;A147:B162;2;Faux);""<10 ans"")"
ou en tout cas lorsque je saisis une valeur dans K4 ou S6 ou Y6

- mais que je puisse aussi y saisir directement une valeur, ce qui a pour conséquence d'effacer la formule

tant pis, je vais chercher une autre solution

cdt

 

[pat66]

re,

voila j'ai testé cette approche et ca a l'air de fonctionner, qu'en pensez vous ? merci

Private Sub Worksheet_Change(ByVal Target As Range)
Worksheets("simulateur").Unprotect "toto"
Application.ScreenUpdating = False
Application.EnableEvents = False

Select Case Target.Address(0, 0)
  Case Is = "K4"
    Range("F27").FormulaLocal = "=SIERREUR(RECHERCHEV(S6;A147:B162;2;Faux);""<10 ans"")"
    Range("S6") = Range("Y50")
  Case Is = "S6"
    Range("F27").FormulaLocal = "=SIERREUR(RECHERCHEV(S6;A147:B162;2;Faux);""<10 ans"")"
  Case Is = "Y6"
   Range("F27").FormulaLocal = "=SIERREUR(RECHERCHEV(S6;A147:B162;2;Faux);""<10 ans"")"
End Select

If Not Intersect(Target, Me.Range("F27")) Is Nothing Then
If Range("F27").Value < Range("B162").Value Then
MsgBox "1"
Else
'If Range("S6").Value <> Range("Q49").Value Then
MsgBox "2"
End If
End If

Application.EnableEvents = True
Application.ScreenUpdating = True
Worksheets("simulateur").Protect "toto"
End Sub

 

[TooFatBoy]

Bonjour,

Pliiiiiz, utilise la balise code avec le paramètre vb.

 

[pat66]

Oh oui desike

Bonjour,

Pliiiiiz, utilise la balise code avec le paramètre vb.

Oh oui désolé

 

[pat66]

Private Sub Worksheet_Change(ByVal Target As Range)
Worksheets("simulateur").Unprotect "toto"
Application.ScreenUpdating = False
Application.EnableEvents = False

Select Case Target.Address(0, 0)
  Case Is = "K4"
    Range("F27").FormulaLocal = "=SIERREUR(RECHERCHEV(S6;A147:B162;2;Faux);""<10 ans"")"
    Range("S6") = Range("Y50")
  Case Is = "S6"
    Range("F27").FormulaLocal = "=SIERREUR(RECHERCHEV(S6;A147:B162;2;Faux);""<10 ans"")"
  Case Is = "Y6"
   Range("F27").FormulaLocal = "=SIERREUR(RECHERCHEV(S6;A147:B162;2;Faux);""<10 ans"")"
End Select

If Not Intersect(Target, Me.Range("F27")) Is Nothing Then
If Range("F27").Value < Range("B162").Value Then
MsgBox "1"
Else
'If Range("S6").Value <> Range("Q49").Value Then
MsgBox "2"
End If
End If

Application.EnableEvents = True
Application.ScreenUpdating = True
Worksheets("simulateur").Protect "toto"
End Sub

 

[TooFatBoy]

Private Sub Worksheet_Change(ByVal Target As Range)
'
    Worksheets("simulateur").Unprotect "toto"
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Select Case Target.Address(0, 0)
    Case "K4"
        Range("F27").FormulaLocal = "=SIERREUR(RECHERCHEV(S6;A147:B162;2;Faux);""<10 ans"")"
        Range("S6") = Range("Y50")
    Case "S6"
        Range("F27").FormulaLocal = "=SIERREUR(RECHERCHEV(S6;A147:B162;2;Faux);""<10 ans"")"
    Case "Y6"
        Range("F27").FormulaLocal = "=SIERREUR(RECHERCHEV(S6;A147:B162;2;Faux);""<10 ans"")"
    End Select

    If Not Intersect(Target, Me.Range("F27")) Is Nothing Then
        If Range("F27").Value < Range("B162").Value Then
            MsgBox "1"
        Else
'            If Range("S6").Value <> Range("Q49").Value Then
            MsgBox "2"
        End If
    End If

    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Worksheets("simulateur").Protect "toto"

End Sub

 

[pat66]

bonjour le fil,
un grand merci TooFatBoy pour la correction, cela fonctionne impeccable

Bonne journée à tous