XL 2019 Remplacer .Value < par une formule de calcul

Dravol · 9 Octobre 2020

Bonjour à tous,

J'aimerai remplacer .value < 35 par une formule de type .formula = "i10*0.7"
sachant que ma cellule i10 est fusionnée avec i11
et répéter cette opération de la cellule D19 à D48

If Target.Address = Range("d19").Address And Range("d19").Value < 35 Then

à votre écoute^^

soan · 9 Octobre 2020

Bonsoir Dravol,

Je te propose ce code VBA :

VB:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  With Target
    If .CountLarge > 1 Then Exit Sub
    If Intersect(Target, [D19:D48]) Is Nothing Then Exit Sub
    Application.EnableEvents = 0
    If .Value < 35 Then .Value = [I10] * 0.7
    Application.EnableEvents = -1
  End With
End Sub

soan

Dravol · 12 Octobre 2020

Bonjour soan

Merci pour ta réponse, je vais tester.

Par contre la valeur 35 était un exemple car la cellule I10 va varier en fonction du produit.

Je te mets ma macro ci-dessous :

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
On Error GoTo line
If Target.Address = Range("d19").Address And Range("d19").Value < 35 Then
'If Target.Address = Range("d19").MergeArea.Address And Range("d19").Value < 35 Then
Dim I
For I = 1 To 3 ' Loop 3 times.
Beep
'PlaySound ThisWorkbook.Path & "\0257", 0, 1
MsgBox "Attention valeur hors tolérance"
Next I
End If

line:
Exit Sub
End Sub

soan · 12 Octobre 2020

Bonjour Dravol,

attention : ton Exit Sub juste avant le End Sub ne sert à rien,
puisque même sans, on sort aussitôt de la sub !

J'ai réécrit ta sub ainsi (avec une ou deux autres modifs) :

VB:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
  On Error GoTo Fin
  If Target.Address(0, 0) = "D19" And [D19] < 35 Then
  'If Target.Address(0, 0) = [D19].MergeArea.Address And [D19] < 35 Then
    Dim I As Byte
    For I = 1 To 3 'Loop 3 times.
      Beep
      'PlaySound ThisWorkbook.Path & "\0257", 0, 1
      MsgBox "Attention valeur hors tolérance"
    Next I
  End If
Fin:
End Sub

soan

Dravol · 13 Octobre 2020

soan à dit:
Bonjour Dravol,

attention : ton Exit Sub juste avant le End Sub ne sert à rien,
puisque même sans, on sort aussitôt de la sub !

J'ai réécrit ta sub ainsi (avec une ou deux autres modifs) :

VB:

Private Sub Worksheet_Change(ByVal Target As Excel.Range) On Error GoTo Fin If Target.Address(0, 0) = "D19" And [D19] < 35 Then 'If Target.Address(0, 0) = [D19].MergeArea.Address And [D19] < 35 Then Dim I As Byte For I = 1 To 3 'Loop 3 times. Beep 'PlaySound ThisWorkbook.Path & "\0257", 0, 1 MsgBox "Attention valeur hors tolérance" Next I End If Fin: End Sub

soan
[/QUO

soan à dit:

Bonjour Dravol,

attention : ton Exit Sub juste avant le End Sub ne sert à rien,
puisque même sans, on sort aussitôt de la sub !

J'ai réécrit ta sub ainsi (avec une ou deux autres modifs) :

VB:

Private Sub Worksheet_Change(ByVal Target As Excel.Range) On Error GoTo Fin If Target.Address(0, 0) = "D19" And [D19] < 35 Then 'If Target.Address(0, 0) = [D19].MergeArea.Address And [D19] < 35 Then Dim I As Byte For I = 1 To 3 'Loop 3 times. Beep 'PlaySound ThisWorkbook.Path & "\0257", 0, 1 MsgBox "Attention valeur hors tolérance" Next I End If Fin: End Sub

soan

Cliquez pour agrandir...

Bonjour soan

Merci pour ces commentaires et modifs

Comme je m'explique très mal, je te mets mon fichier pour que tu vois qu'en i10 la valeur varie et donc je dois mettre une formule du type : D19 = i10*0,7 et cela répétable [D19:H48]

soan · 13 Octobre 2020

Bonjour Dravol,

Ton fichier en retour ; fais tous les essais nécessaires, puis regarde le code VBA.
Attention : lis très attentivement tous les commentaires que j'y ai mis (en vert) !

Si tu as besoin d'une adaptation, dis-le moi ; à te lire pour avoir ton avis.

soan

Dravol · 13 Octobre 2020

soan

Merci pour ce retour.

La plage [D19:E22;D24:E43;D45:E48] ne doit pas se remplir automatiquement car c'est une personne qui doit mettre les valeurs qu'elle trouve.
Le principe est d'afficher un message d'erreur si la valeur saisie est < à la valeur de la cellule i10*0.7

Exemple je saisie 50 dans i10 et si je rentre la valeur 34 dans D19, mon beep se déclenche avec la msgbox (car 50*0.7 = 35 et si D19 = 34 alors 34 < 35).

La cellule i10 peut avoir n'importe quelle valeur, la seule chose qui est tjrs vrai c'est "beep + msgbox" quand [D19:E22;D24:E43;D45:E48] < i10*0.7

Pour tous tes commentaires je vais regarder ça à tête reposée et bien me concentrer car je débute en VBA ^^.

Drav.

soan · 13 Octobre 2020

@Dravol

Désolé, j'avais mal compris ton exo ; je vais le refaire, à partir de tes nouvelles infos.

En attendant, essaye juste ce petit code VBA :

VB:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
  Dim n&
  With Target
    n = .CountLarge: If n > 2 Then Exit Sub
    If .Column <> 4 Then Exit Sub
    MsgBox n & "   " & .Address(0, 0) & "   " & .Column
  End With
End Sub

* la cellule D19 étant vide, saisis 100 en D19 ➯ msessage : 1 D19 4
même si c'est une fusion D:E, ça compte pour 1 seule cellule,
l'adresse de Target est D19, et la colonne de Target est D.

* touche Suppr pour supprimer D19 ➯ message : 2 D19:E19 4
le nombre de cellules sélectionnées est 2, car Target est la fusion D19:E19,
ce qui est bien indiqué par le .Address(0,0) du Target ; sa colonne est
toujours D, même si l'adresse est de 2 cellules.

* avec ce qui est décrit ci-dessus, ça explique : If n > 2 Then Exit Sub
on continue en dessous uniquement pour les valeurs 1 et 2, sinon on sort
de la sub si c'est 3 ou plus.

* avec ce code VBA, je suis sûr que c'est une cellule de la colonne D
(ou de la fusion D:E) qui est modifiée ; l'étape suivante va être de
contrôler le n° de ligne, pour que seules les lignes de saisie pour
l'Epaisseur mini soient prises en compte.

soan

soan · 13 Octobre 2020

@Dravol

Je pense que cette fois, ça devrait être ok.

soan

Dravol · 13 Octobre 2020

soan

Presque parfait^^

la seule chose c'est que la valeur saisie dans la cellule disparait après tabulation

soan · 13 Octobre 2020

Re,

Tu as écrit : « la valeur saisie dans la cellule disparaît après tabulation »

oui, je le sais bien, lollllll ! j'ai voulu t'en laisser la surprise ; voici l'explication :

tu saisis 34 ; puis comme 34 < 50, le message "hors tolérance" s'affiche ; alors j'ai pensé
que tu aurais aimé qu'on efface la mauvaise valeur automatiquement ➯ ça revient à
l'état avant la saisie erronée, donc la cellule est de nouveau vide (sans que tu aies eu
besoin d'appuyer sur la touche Suppr) ; et note bien que la valeur saisie n'est effacée
que si elle est hors tolérance : si c'est une bonne valeur, elle reste ! (heureusement)

perso, je préfère comme ça ! mais si tu préfères que la valeur erronée reste dans
la cellule de saisie après affichage du message "hors tolérance", alors utilise
le fichier joint ci-dessous.

soan

soan · 13 Octobre 2020

@Dravol

Voici le code VBA sans effacement de la valeur erronée (hors tolérance) :

VB:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
  With Target
    If .CountLarge > 1 Then Exit Sub
    If .Column <> 4 Then Exit Sub
    Dim lig&: lig = .Row
    If lig < 19 Or lig > 48 Then Exit Sub
    If lig = 23 Or lig = 44 Then Exit Sub
    If .Value >= Round([I10] * 0.7, 0) Then Exit Sub
    Dim i As Byte
    For i = 1 To 3 'Loop 3 times.
      Beep
      'PlaySound ThisWorkbook.Path & "\0257", 0, 1
    Next i
    MsgBox "Attention valeur hors tolérance"
  End With
End Sub

et voici le code VBA avec effacement de la valeur hors tolérance :

Code:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
  With Target
    If .CountLarge > 1 Then Exit Sub
    If .Column <> 4 Then Exit Sub
    Dim lig&: lig = .Row
    If lig < 19 Or lig > 48 Then Exit Sub
    If lig = 23 Or lig = 44 Then Exit Sub
    If .Value >= Round([I10] * 0.7, 0) Then Exit Sub
    Dim i As Byte
    For i = 1 To 3 'Loop 3 times.
      Beep
      'PlaySound ThisWorkbook.Path & "\0257", 0, 1
    Next i
    MsgBox "Attention valeur hors tolérance"
    Application.EnableEvents = 0
    .Value = Empty
    Application.EnableEvents = -1
  End With
End Sub

La seule différence entre les 2 codes VBA, c'est les 3 lignes
qui sont juste après le MsgBox et avant le End With.

soan

Dravol · 13 Octobre 2020

soan

Merci nickel^^

Une dernière chose, sais-tu pourquoi For i = 1 To 3 ne s'applique pas ? (1 seul beep au lieu de 3)
Alors qu'avant toutes ces modifications ils fonctionnaient ?

soan · 13 Octobre 2020

dis-moi d'abord quelle version tu as préférée : avec effacement de la valeur hors tolérance ?
ou sans cet effacement ? c'est ton choix, hein ? fais comme tu veux : je t'oblige à rien !

soan

Dravol · 14 Octobre 2020

@soan

La version sans effacement de la valeur hors tolérance est parfaite (c'est se que je souhaitais).
Juste 3 "beep" au lieu d'un et le sujet sera clos pour moi^^.

Merci encore pour le temps passé à m'aider et je reste impressionné par vos facilités en VBA

(je dirai même un peu jaloux). Il faudrait que je m'y mette plus sérieusement mais je prends pas le tps...

XL 2019 Remplacer .Value < par une formule de calcul

XLDnaute Junior

XLDnaute Barbatruc

XLDnaute Junior

XLDnaute Barbatruc

XLDnaute Junior

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Junior

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Junior

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Junior

XLDnaute Barbatruc

XLDnaute Junior

Discussions similaires

Partager cette page

Statistiques des forums