TTT sur cellule en VBA

[Leskwal]

BONJOUR LE FORUM

Voila mes petites questions ...

J'ai développé un p'tit fichier excel.

En VBA, j'ai défini une zone, on dira de A1 à Z33, qui lorsque je saisis en A1 ou A2 ... Z33 on certains nombres de conditions sont activées.

Ex : si ce qui est entré n'est pas numérique, la valeur est mise à 0 et un message indique : "Valeur non numérique" ... ETC

Je souhaiterais connaitre le code pour les tests suivants.

1 -
Si le 100éme du nombre entré est DIFFÉRENT à 0; 5; ou rien alors : nombre remis à 0 avec message : "nombre invalide". (pas la peine de vous "casser" pour la remise à 0 et le message : je sais faire )
Ex : Si 6.15 est entré => OK
Si 6.35 est entré => OK
Si 6.3 est entré => OK

En revanche si : Si 6.37 est entré => remise à 0 et message erreur

2 -
Incrémenter le chiffre de devant la virgule. (Calcul en 100ème d'heure)
Ex : Si 6.15 est entré => cellule = 6.00
Si 6.25 est entré => cellule = 6.5
Si 6.55 est entré => cellule = 7.00


Si vous avez une idée, je suis preneur.

Un très grand merci d'avance.

Très cordialement

Pascal

 

[job75]

Re : TTT sur cellule en VBA

Bonjour Leskwal,

A essayer dans le code de la feuille :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Set r = Intersect(Target, [A1:Z33])
If r Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each r In r 'si entrées multiples (copier-coller)
  If Not IsNumeric(r) Then r = 0
  If 20 * r <> Int(20 * r) Then r = 0
  r = Format(2 * r, "0") / 2
Next
Application.EnableEvents = True
End Sub

Nota 1 : je ne mets aucun message d'erreur car à mon avis ils sont totalement inutiles.

Nota 2 : pas logique votre "Si 6.55 est entré => cellule = 7.00"

Avec mon code : Si 6.55 est entré => cellule = 6.50

Avec mon code : Si 6.70 est entré => cellule = 6.50

Avec mon code : Si 6.75 est entré => cellule = 7.00

A+

 

[mapomme]

Re : TTT sur cellule en VBA

Bonsoir Leskwal,

Pour le point n°1, un code à placer dans le module de code de la feuille concernée:

Private Sub Worksheet_Change(ByVal Target As Range)
  Application.EnableEvents = False
    If Target.Count = 1 Then
      If Not Intersect(Target, Range("A1:Z33")) Is Nothing Then
        If IsNumeric(Target.Value) Then
          If (100# * Target.Value Mod 5) <> 0 Then
            MsgBox "nombre invalide"
            Target = 0
          End If
        Else
          MsgBox "Valeur non numérique"
          Target = 0
        End If
      End If
    End If
  Application.EnableEvents = True
End Sub

Point n°2 : pas traité car je ne comprends pas la logique de vos arrondis.
Pourquoi 6,55 est il arrondi à 7.00 et non à 6,50 alors que 6,15 est arrondi à 6,00 ?

Edit: Bonsoir job75, j'avions point rafraichit

 

[Leskwal]

Re : TTT sur cellule en VBA

WAOUHHH

MERCI MERCI

Je teste vos propositions.

Encore un GROS MERCI

Très cordialement

Pascal

 

[Leskwal]

Re : TTT sur cellule en VBA

Heu une p'tie question

Dans le code :

If (100# * Target.Value Mod 5) <> 0 Then

C'est quoi Mod 5 ?


Merci

Pascal

 

[mapomme]

Re : TTT sur cellule en VBA

(re)Bonsoir Leskwal,

Tiré de l'aide de Excel-VBA:

Mod, opérateur

Voir aussi Exemple Particularités
Permet de diviser deux nombres en ne renvoyant que le reste.
Syntaxe
result = number1 Mod number2
La syntaxe de l'opérateur Mod comprend les éléments suivants :

Élément	Description
result	Toute variable numérique.
number1	Toute expression numérique.
number2	Toute expression numérique.

Remarques
L'opérateur modulo, ou reste, divise l'argument number1 par l'argument number2 (en arrondissant les nombres à virgules flottantes à des nombres entiers) et ne retourne que le reste dans l'argument result. Par exemple, dans l'expression ci-dessous, A (argument result) est égal à 5.
A = 19 Mod 6.7
En général, le type de données de l'argument result est Byte, un variant de type Byte, Integer, un variant de type Integer, Long ou Variant contenant une donnée de type Long, que l'argument result soit ou non un nombre entier. La partie décimale est tronquée. Cependant, si une expression est Null, l'argument result est Null. Toute expression Empty est traitée comme si elle avait la valeur 0.

Dans l'éditeur de code VBA, la touche de fonction F1 est votre amie. Dans le code, placer le curseur dans le terme MOD puis appuyer sur la touche F1.

 

[job75]

Re : TTT sur cellule en VBA

Re, hello mapomme,

Avec le code du post #2, quand on efface une plage des zéros s'inscrivent.

Si l'on veut vraiment effacer :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Set r = Intersect(Target, [A1:Z33])
If r Is Nothing Then Exit Sub
For Each r In r 'si entrées multiples (copier-coller)
  If Not IsNumeric(r) Then r = 0
  If 20 * r <> Int(20 * r) Then r = 0
  If r <> "" Then r = Format(2 * r, "0") / 2
Next
End Sub

A+

 

[Leskwal]

Re : TTT sur cellule en VBA

Pour mapomme

A l'interrogation :

Point n°2 : pas traité car je ne comprends pas la logique de vos arrondis.
Pourquoi 6,55 est il arrondi à 7.00 et non à 6,50 alors que 6,15 est arrondi à 6,00 ?

la réponse est simple.

Je travaille pour un organisme de formation, où arriver en retard pour les stagiaires est "tout à fait normal".
Financement des formations par la région Île de France, donc nos impôts ... Ça m’agace...
Maintenant, j'ai des formateurs à l'heure que je dois payer.

Pour information : le stagiaire est "roi".
Je n'ai aucunement le droit de le facturer pour une prestation faite alors qu'il était absent, de manière injustifiée (code du travail).

Notre organisme n'est payé que si le stagiaire est présent.
En conséquence : le formateur est présent; le stagiaire est absent; je dois quand même payer le formateur (ce qui me semble normal car, LUI, honore son contrat ....)

Je suis donc obligé de calculer des cotes malles taillées.

Pour résumer : (en Centième d'heure )

Si le stagiaire arrive en cours à :
08h25 ( en centième Soit 08H15 en 60ème) je facture comme si il était arrivé à l'heure soit 08h00)
Si le stagiaire arrive en cours à :
08h50 ( en centième Soit 08H30 en 60ème) je facture comme si il était arrivé à 08h50) = Normal
Si le stagiaire arrive en cours à :
08h75 ( en centième Soit 08H45 en 60ème) je facture comme si il était arrivé à 09h00) (Notre organisme perd à ce moment là de l'argent, mais honnêteté oblige....).


J'espère avoir été clair

Très cordialement

Pascal

 

[job75]

Re : TTT sur cellule en VBA

Re,

OK tout le monde a bien compris pour 8.75...

Donc l'exemple du 6.55 au post #1 c'est bien une erreur de votre part ?

A+

 

[Leskwal]

Re : TTT sur cellule en VBA

Bonjour

Heu...non

Si 6.55 est entré => cellule = 7.00 (La 1/2 heure étant dépassée, je pointe à partir de l'heure suivante)

Cordialement

Pascal

 

[job75]

Re : TTT sur cellule en VBA

Bonjour Leskwal,

Je comprends qu'il faut tester si la demi-heure est dépassée ou non.

Alors voyez le dernier test de mon code :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, h!
Set r = Intersect(Target, [A1:Z33])
If r Is Nothing Then Exit Sub
For Each r In r 'si entrées multiples (copier-coller)
  If Not IsNumeric(r) Then r = 0
  If 20 * r <> Int(20 * r) Then r = 0
  h = Int(r) + 0.5
  If r <> "" Then r = Int(r) + IIf(r < h, 0, IIf(r = h, 0.5, 1))
Next
End Sub

A+

 

[job75]

Re : TTT sur cellule en VBA

Re,

A mon sens, puisque vous facturez des demi-heures, il seraît plus logique de tester les quarts d'heures :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, h!
Set r = Intersect(Target, [A1:Z33])
If r Is Nothing Then Exit Sub
For Each r In r 'si entrées multiples (copier-coller)
  If Not IsNumeric(r) Then r = 0
  If 20 * r <> Int(20 * r) Then r = 0
  h = Int(r) + 0.5
  If r <> "" Then r = Int(r) + IIf(r <= h - 0.25, 0, IIf(r >= h + 0.25, 1, 0.5))
Next
End Sub

A+

 

[Leskwal]

Re : TTT sur cellule en VBA

Bonjour

Très juste.

Quoiqu'il en soit, un GRAND MERCI pour votre disponibilité.

Très cordialement et bon WE

Pascal

 

[Leskwal]

Re : TTT sur cellule en VBA

Re

Souci.

Quand j'inclus le code dans un fichier vierge pour test, il m'indique l'erreur :

Erreur d'exécution 28.
Espace pile insuffisant.

Voir fichier... Une idée ??

Merci

Pascal

 

[mapomme]

Re : TTT sur cellule en VBA

Bonsoir Leskwal,

Une adaptation de mon premier code avec l'arrondi à la demi-heure la plus proche.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim xplage As Range, xcell As Range
  Application.EnableEvents = False
    Set xplage = Intersect(Target, Range("A1:Z33"))
    If Not xplage Is Nothing Then
      For Each xcell In xplage
        If Not IsEmpty(xcell) Then
          If IsNumeric(xcell.Value) Then
            If (100# * xcell.Value Mod 5) <> 0 Then
              MsgBox "nombre invalide"
              xcell = 0
            Else
              xcell = Application.WorksheetFunction.MRound(xcell, 0.5)
            End If
          Else
            MsgBox "Valeur non numérique"
            xcell = 0
          End If
        End If
      Next xcell
    End If
  Application.EnableEvents = True
End Sub