Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Microsoft 365 Private Sub Worksheet_Change(ByVal Target As Range)

P

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
'...
Trier par date Trier par votes

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
 
Vote positif 0 Vote négatif
P

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:
Vote positif 0 Vote négatif
P

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:
Vote positif 0 Vote négatif
P

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:
Vote positif 0 Vote négatif

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
 
Vote positif 0 Vote négatif
Solution
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

A
  • Résolu(e)
XL 2010 Private Sub Worksheet_Change
Réponses
2
Affichages
230
Atlas85200
A
T
  • Question
Microsoft 365 alerte si cellule change de valeur
Réponses
14
Affichages
306
thenesol
T
  • Question
XL 2013 Réduire un code
Réponses
0
Affichages
494
chaelie2015
A
  • Question
insertion d'une ligne automatique dans un tableau excel.
Réponses
1
Affichages
280
sylvanu
K
  • Question
Microsoft 365 création mot passe classique avec un code
Réponses
1
Affichages
266
Gégé-45550
  • Question
Microsoft 365 Incompatibilité de type
Réponses
1
Affichages
283
Dranreb
S
  • Question
Microsoft 365 Clavier virtuel: SelectionChange, empêche la répétition
Réponses
3
Affichages
353
Simon 1234
S
C
  • Question
XL 2016 VBA Détecter la suppression de la dernière ligne d'un Tableau
Réponses
9
Affichages
441
crocrocro
C
P
  • Question
Microsoft 365 TextBox avec limitation de la saisie entre 2 valeurs
Réponses
8
Affichages
258
pat66
P
S
  • Résolu(e)
Microsoft 365 Ecrasement d'une ligne si déjà existante
Réponses
2
Affichages
158
sebastien176
S
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…