Format nombre avec VBA

Version imprimable

Voir 40 message(s) de cette discussion en une page

apres vu comment j'ai conçu le moteur au départ
on simplifie encore plus

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim formatage$, chaine$, Fx#
    If Target.Column = 1 And Target.Count = 1 Then
        chaine = Replace(Target.Value, " ", "") 'on cherche pas a comprendre on replace automatiquement la chaine
        If Len(chaine) Mod 2 <> 0 And chaine <> "" Then 'si c 'est impair et pas vide
            Fx = (Len(chaine) / 2) - 1    'pour obtenir le nombre de tranches -1 parce que on vire la derniere car elle est de 3
            formatage = Application.Rept("@@ ", Round(Fx)) & "@@@"    'creation du pattern(modele de formatage
            Target.Value = Trim(Format(chaine, formatage))    'application du formatage
        Else
            MsgBox "Nombres de caractères/chiffres incorrects": Application.Goto Target: Exit Sub
        End If
    End If
End Sub

bref il a ce qu'il faut

et comme je suis d'humeur decoupeuse j'en enleve un peu plus

Code:

1
2
3
4
5
6
7
8
9
10
11
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim chaine$
    If Target.Column = 1 And Target.Count = 1 Then
        chaine = Replace(Target.Value, " ", "") 'on cherchje pas a comprendre on replace automatiquement la chaine
        If Len(chaine) Mod 2 <> 0 And chaine <> "" Then 'si c 'est impair et pas vide
               Target.Value = Trim(Format(chaine, Application.Rept("@@ ", 30) & "@@@"))    'application du formatage
        Else
            MsgBox "Nombres de caractères/chiffres incorrects": Application.Goto Target: Exit Sub
        End If
    End If
End Sub

:ptdr::ptdr:

14/10/2017, 18h20
RyuAutodidacte

Re,

Code:

if len(chaine) mod 2<>0

le problème avec ce code là c'est que tu ne bloques pas à 13, 15 ou 17, alors que c'est le but

on peut avoir tous ces résultats :

Citation:

01 02 03 04 05 06 07 789
01 02 03 04 05 06 789
01 02 03 04 05 789
01 02 03 04 789
01 02 03 789
01 02 789
01 789

et bien d'autres
14/10/2017, 18h26
patricktoulon

re

oui c'est le but de ne pas limiter comme ca si il y a changement il aura rien a toucher
vu que ca a changé 4 fois en 4 pages ;):ptdr:

je vais arrêter la sinon j'en enlève encore :mouarf:
aller pour la peine comme ca a l'air de t'ennuyer

ceci fera les 4 test longueur ,le test vide et le len impair
12 14 16 18 ne passeront pas

Code:

If Len(chaine) Mod 2 <> 0 And chaine <> "" and len(chaine)>12 and len(chaine)<=17 Then 'si c 'est impair et pas vide

je dirais même mieux avec cette ligne on peu se passer du test vide si tu réfléchi bien:ptdr:
14/10/2017, 18h27
NEC14

C'est certain que je m'appliquerai la prochaine fois dans l’énoncé de mon problème, mon but n'étant pas de vous faire perdre votre temps.
Encore une fois je suis désolé.
Je vous souhaite à tous un excellent weekend
Salutations très amicales
René
14/10/2017, 18h52
RyuAutodidacte

Pas de souci RENE14, et pas la peine de t'excuser autant :D, y a plus grave ;)
Cela pourra te servir pour ce que tu fait, voir pour autre chose ayant des similitudes

Patrick, si tu veux 13, 15, 17 :
il peut être fait comme ceci aussi (dans la fenêtre d'exécution pour test)

Code:

Lenchaine = 13: Debug.Print "13 15 17" like "*" & Lenchaine & "*"

=>

Code:

If "13 15 17" like "*" & Len(chaine) & "*" then

t'en fait pas René14 ryu et moi aimons les colles de ce genre
perso je t'ai très bien compris des le départ même si les longueurs n'étaient pas claires j'y ai fait abstraction

dans ce modèle tu n'aura qu'a changer 12 ou 17 si tes longueurs doivent changer et puis c'est tout

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim chaine$
    If Target.Column = 1 And Target.Count = 1 Then
        chaine = Replace(Target.Value, " ", "") 'on cherchje pas a comprendre on replace automatiquement la chaine
        If Len(chaine) Mod 2 <> 0 And Len(chaine) > 12 And Len(chaine) <= 17 Then 'si c 'est impair et pas vide
               Target.Value = Trim(Format(chaine, Application.Rept("@@ ", 30) & "@@@"))    'application du formatage
        Else
            MsgBox "Nombres de caractères/chiffres incorrects": Application.Goto Target: Exit Sub
        Target.Select
        End If
    End If
End Sub

c'est imparable je l'ai testé dans tout les sens

14/10/2017, 19h12
patricktoulon

re

non ryu les like sont ciblant 13,15 ou 17

len(chaine)mod 2<>0 pour vérifier le nombre impair
>12 pour le plus petit demandé (le 13)
<=17 pour le plus grand (le 17)

ces 3 conditions remplace les condition like ou len 13,15,17,vide,impairs
et surtout en cas d'évolution
et en changeant rien que 12 ou 17 on peut aller plus bas ou plus haut sans rien changer d'autre

il manque une seul chose a ce truc pour que ce soit perfect
j'ai mis avec le msgbox target.
select pour revenir dessus
il faudrait ajouter le selstart a la fin de la cellule ,je sais pas si c'est possible avec une cells ca serait perfect sinon
14/10/2017, 19h14
RyuAutodidacte

:ptdr:

Citation:

c'est imparable je l'ai testé dans tout les sens

:ptdr:
t'es sûr :mrgreen:

si tu effaces une donnée dans une cellule ou si tu doubles clik dans une cellule mais que tu n'y marques rien (car ce n'est pas la bonne cellule) et tu sors de celle-ci en validant de la touche retour :
SURPRISE :mouarf:

Edit :

Citation:

non ryu les like sont ciblant 13,15 ou 17

ben ici c'est ce que l'on veut 13, 15 ou 17
ça aurait pu être 13, 15 et 23 (etc …) => tu fais comment ??
14/10/2017, 19h30
patricktoulon

re

désolé je n'ai pas cette réaction chez moi

si je tape pair j'ai le message
si je tape plus petit que 13 j'ai le message
si je tape >17 j'ai le message
si je réfectionne et fait rien ca reste comme tel
si je sélectionne une partie et que j'en retape moins ou plus j'ai le message
et si je vide ca vide et puis c'est tout

Citation:

ça aurait pu être 13, 15 et 23 (etc …) => tu fais comment ??

je viens de te le dire 12 et 17 a modifier et c'est tout
14/10/2017, 19h38
RyuAutodidacte

1 pièce(s) jointe(s)

voilà ce que ça me fait :

Pièce jointe 319458

je vais me mettre sur PC pour tester

1 pièce(s) jointe(s)

re

Pièce jointe 319461

a oui j'ai pas poster le bon mince!!

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim chaine$
    If Target.Column = 1 And Target.Count = 1 Then
        chaine = Replace(Target.Value, " ", "")    'on cherchje pas a comprendre on replace automatiquement la chaine
        If Len(chaine) > 12 And Len(chaine) <= 17 And Len(chaine) Mod 2 <> 0 Then    'si c 'est impair et pas vide
            Target.Value = Trim(Format(chaine, Application.Rept("@@ ", 30) & "@@@"))    'application du formatage
        Else
            If Target <> "" Then MsgBox "Nombres de caractères/chiffres incorrects": Application.Goto Target: Exit Sub
            Target.Select
        End If
    End If
End Sub

si tu tiens absolument au test vide

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim chaine$
    If Target.Column = 1 And Target.Count = 1 And Target <> "" Then
        chaine = Replace(Target.Value, " ", "")    'on cherchje pas a comprendre on replace automatiquement la chaine
        If Len(chaine) > 12 And Len(chaine) <= 17 And Len(chaine) Mod 2 <> 0 Then    'si c 'est impair et pas vide
            Target.Value = Trim(Format(chaine, Application.Rept("@@ ", 30) & "@@@"))    'application du formatage
        Else
            MsgBox "Nombres de caractères/chiffres incorrects": Application.Goto Target: Exit Sub
            Target.Select
        End If
    End If
End Sub

encore une fois seul le 12 et 17 a changer pour évoluer
j'aurais pu mettre >=13 pour être en accord avec la logique et plus précis
quoi qu'il en soit le moteur fonctionne

14/10/2017, 19h58
RyuAutodidacte

Erf du coup j'ai démarré en PC alors que t'avais pas mis le bon code :fessee:
que viens faire ce :

Code:

Target.Select

que l'on déconseille, les Select, Selection ... etc
alors que l'on a :

Code:

Application.Goto Target

a qui l'on peut mettre l'option True si l'on veut

???
14/10/2017, 20h08
patricktoulon

re

re
si tu veux le but étant de revenir sur la cellule si une condition n'est pas remplie
et kéketufou avec mac bah degoulasses:ptdr:
14/10/2017, 20h30
RyuAutodidacte
Ca fait doublon ligne 8 et 9
Code:

1 2 MsgBox "Nombres de caractères/chiffres incorrects": Application.Goto Target: Exit Sub Target.Select
:calim2::roll:

Citation:

et kéketufou avec mac bah degoulasses

Ben je bosse avec :P et en plus je peut être en double Boot MAC/PC
la seule chose qui change c'est le système (et certaine applis)
mais je peux aller d'un autre monde à l'autre, c'est bien de voir ce qui se passe de l'autre coté, faut rester ouvert a tout pour découvrir
(bien sur dans les limites de chacun :ptdr: - tant que ça nuit pas)

Edit :

Citation:

Citation:

ça aurait pu être 13, 15 et 23 (etc …) => tu fais comment ??

je viens de te le dire 12 et 17 a modifier et c'est tout

que fais tu de 17, 19 et 21 que l'on ne doit pas prendre ?? dont tu n'auras pas d'errer ...

Bonjour
Une suggestion :
Vous voulez vous amuser ?
au lieu de vous égarer/éparpiller comme je le constate, amusez-vous au moins à ce qui pourrait vous être un jour utile.

C'est Dimanche ? Vous n'avez rien à faire ? ===>> je ne doute pas une seconde que mille et une abeilles vont s'accaparer (après en avoir compris le sens) la moelle de ceci et ... la "transformer" (voire en diminuer l'efficacité :cfou:) ===>
Code:

1 2 3 4 5 6 7 8 9 10 11 chaine = "A123456789120" eclate = Array(0, 0, 2, 3, 5, 1, 2) seps = Array("", "", "#", "-", "/", "\", "") For i = 1 To UBound(eclate) eclate(i) = eclate(i) + eclate(i - 1) Next titi = Split(StrConv(chaine, vbUnicode), Chr(0)) For n = 2 To UBound(eclate) titi(eclate(n)) = seps(n) & titi(eclate(n)) Next MsgBox Join(titi, "")
Allons allons ...

EDIT (quand-même, hein ...) : le premier qui m'interroge sur le fait que cet exemple n'utilise pas directement Format est mis au piquet (il n'aura pas compris/deviné/vu à quoi faire ainsi peut servir).

ryu

re
ryu
si vraiment les longueurs ne doivent pas se suivre au final c'est encore plus simple
exemple 13 15 21 25' les longueurs séparées par un espace dans la chaine valables
reste plus qu'a modifier la ligne" valables=...." pour une éventuelle évolution

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim chaine$, valables
    valables = " 13 15 21 25 "
    If Target.Column = 1 And Target.Count = 1 And Target <> "" Then
        chaine = Replace(Target.Value, " ", "")    'on cherchje pas a comprendre on replace automatiquement la chaine
        If valables Like "* " & Len(chaine) & " *" Then
            Target.Value = Trim(Format(chaine, Application.Rept("@@ ", 30) & "@@@"))    'application du formatage
        Else
            MsgBox Len(chaine) & " caracteres " & vbCrLf & "Nombres de caractères/chiffres incorrects": Application.Goto Target: Exit Sub
            Target.Select
        End If
    End If
End Sub

@jacques quez ako ton truc

15/10/2017, 09h43
RyuAutodidacte

Re Patrick :D,

Alléluia

tu reprends donc ce que j'avais proposé en post #85
dont l'écriture est plus simple pour indiquer les longueur de chaines voulu ;)

Edit : Jacques, j'avais qq chose en tête de ce type pour une futur fonction, d'où l'idée au début de la discussion de le faire par séquence en post #15
Bien sur les idée fusées au fur et à mesure de la discussion afin d'imaginer les meilleurs options
ça vaut bien un :plusser: ;)

Edit : Jacques je l'avais mis à jour en post #18
15/10/2017, 10h09
unparia

Bonjour Patrick

Citation:

@jacques quez ako ton truc

Ce n'est quelque chose que pour ceux qui "voient" ce à quoi cela peut servir astucieusement (et on parle alors là principalement de conception et beaucoup moins de développement) . Un indice : le 1er array peut ne pas être constitué de constantes.
Sans intérêt, par contre, pour tous les autres ...
Cherche. Si tu ne vois pas --->> laisse tomber.
15/10/2017, 12h21
patricktoulon

re
j'ai très bien compris
c'est en quelque sorte une matrice dynamique qui est gérée par tes deux array en terme de placement et!!! caractères
une matrice dans un array cadencée par le 2d array

mais en l'occurrence ici format suffit amplement
et dans mon dernier moteur je fait même abstraction de la longueur pour le formatage puisque j'utilise trim
ceci fonctionnera toujours
Code:

1 2 3 msgbox Trim(Format("123456789", Application.Rept("@@ ", 30) & "@@@")) msgbox Trim(Format("1234567", Application.Rept("@@ ", 30) & "@@@"))
la seul chose ici qui était a faire c'est une condition sur le len avant injection dans format et c'est tout
mais comme les longueurs ont changées 4 fois en 4 pages ca a duré plus longtemps :mouarf:
c'est pour cela que j'ai opté pour le trim sur format comme ca il peut changer tant qu'il veut se sera toujours bon
pas la peine de sortir une artillerie pareille +

Voir 40 message(s) de cette discussion en une page