TTT sur cellule en VBA

  • Initiateur de la discussion Initiateur de la discussion Leskwal
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Leskwal

XLDnaute Occasionnel
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
 
Re : TTT sur cellule en VBA

Bonsoir à tous,

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

J'avais enlevé à tord les Application.EnableEvents, il faut les mettre :

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
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
  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
Application.EnableEvents = True
End Sub
Bonne nuit.
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
1
Affichages
5 K
Retour