Microsoft 365 Private Sub Worksheet_Change(ByVal Target As Range)

pat66

XLDnaute Impliqué
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

Code:
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
 
Dernière modification par un modérateur:
Solution
VB:
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
'...

patricktoulon

XLDnaute Barbatruc
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
VB:
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

XLDnaute Impliqué
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
 
Dernière édition:

pat66

XLDnaute Impliqué
re,

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

VB:
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
 
Dernière modification par un modérateur:

pat66

XLDnaute Impliqué
VB:
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
 
Dernière modification par un modérateur:

TooFatBoy

XLDnaute Barbatruc
VB:
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
 

Discussions similaires

Réponses
1
Affichages
110

Statistiques des forums

Discussions
313 197
Messages
2 096 121
Membres
106 502
dernier inscrit
Jc_dan