XL 2016 Supprimer dernier caractère de cellule.

Etoto

XLDnaute Barbatruc
Bonjour,

Est ce que quelqu'un pourrais créer une fonction grâce au VBA qui supprime automatiquement le dernier caractère d'une cellule ?

Merci d'avance
 
Solution
Re,
Expliqué comme ça c'est plus simple.
Pourquoi ne pas modifier la macro de Staple pour supprimer le dernier caractère :
VB:
Function PREMLETTRE(S$, Optional casse As VbStrConv) As String
Dim mc As Object, m As Object
With CreateObject("vbscript.regexp")
    .Global = True
    .Pattern = "\b\w"
    If .test(S) = True Then
        Set mc = .Execute(S)
        For Each m In mc
            PREMLETTRE = StrConv(PREMLETTRE & m, casse) & "."
            Next m
        End If
        PREMLETTRE = Left(PREMLETTRE, Len(PREMLETTRE) - 1)
End With
End Function

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Etoto, Soan,
Sans plus d'info, un essai.
Dans cette PJ, si on entre une chaine dans la colonne A alors le dernier caractère est supprimé.
VB:
Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("A1:A100")) Is Nothing Then
        Application.EnableEvents = False
        Target = Left(Target.Value, Len(Target.Value) - 1)
        Application.EnableEvents = True
    End If
End Sub
 

Pièces jointes

  • essai.xlsm
    13.4 KB · Affichages: 10

soan

XLDnaute Barbatruc
Inactif
@Etoto (salut sylvanu et Dudu2)

voici le fichier. :)

VB:
Option Explicit

Function SDC(chn$) As String
  Dim n As Byte: n = Len(chn)
  If n > 0 Then SDC = Left$(chn, n - 1)
End Function

SDC = Sans le Dernier Caractère

soan
 

Pièces jointes

  • Exo Etoto.xlsm
    12.7 KB · Affichages: 8

Dudu2

XLDnaute Barbatruc
Je vais faire le mêle-tout qui intervient même dans les sujets où il ne contribue pas sauf pour mettre du sel sur les égratignures. 😜 Mais quand même...
Effectivement je coirs que c'est plus simple d'utiliser une DROITE ou GAUCHE avec un SI aussi. J'y avais pas pensé merci.
@Etoto, on ne sait pas ce que tu veux faire précisément.
- Est-ce que c'est pour valoriser UNE AUTRE cellule à partir d'une cellule source à tronquer
(Auquel cas c'est @soan qui remporte la coupe avec 2 buts)
- Est-ce que c'est pour valoriser LA MÊME cellule à tronquer de la saisie qui y a été faite
(Auquel cas c'est @sylvanu qui a le dernier mot Jean-Pierre)
La rédaction de ta question laisse plutôt penser à la 2ème option.
Et la solution confirme que c'est la 1ère ;)
 

Etoto

XLDnaute Barbatruc
Je vais te dire pourquoi, sur le forum dans la section VBA, il y'a la possibilité d'utiliser la fonction PREMLETTRE mais elle laisse un "." à la fin et je voulais m'en débarrasser, c'est chose faite avec la fonction SDC de @soan. Et comme tu l'as surement remarqué, moi et les macros, je suis pourris, les seuls choses que je sais faire en macro c'est créer des fonctions qui calculent la TVA ou la fonction CARRE. :D
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Re,
Expliqué comme ça c'est plus simple.
Pourquoi ne pas modifier la macro de Staple pour supprimer le dernier caractère :
VB:
Function PREMLETTRE(S$, Optional casse As VbStrConv) As String
Dim mc As Object, m As Object
With CreateObject("vbscript.regexp")
    .Global = True
    .Pattern = "\b\w"
    If .test(S) = True Then
        Set mc = .Execute(S)
        For Each m In mc
            PREMLETTRE = StrConv(PREMLETTRE & m, casse) & "."
            Next m
        End If
        PREMLETTRE = Left(PREMLETTRE, Len(PREMLETTRE) - 1)
End With
End Function
 

Dudu2

XLDnaute Barbatruc
Ok, je bosse un peu quand même, entre 2 siestes et 3 critiques 🥸
C'est moins élégant qu'un "RegExp" mais je ne sais pas comment coder les lettres accentuées en expression régulière ("ÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝŸàáâãäåçèéêëìíîïñòóôõöùúûüýÿ")

Donc à défaut j'ai fait cette fonction qui corrige les remarques de @Magic_Doctor dans PREMLETTRE.
VB:
'---------------------------------------
'Fonction qui rend l'acronyme d'un texte
'---------------------------------------
Function Acronyme(Cellule As Range) As String
    Dim C As String, S As String
    Dim i As Integer
    Dim Bool As Boolean
    
    S = CStr(Cellule.Value)
    
    For i = 1 To Len(S)
        C = Mid(S, i, 1)
        'Ce test identifie toutes les lettres, accentuées ou pas !
        If StrComp(Ucase(C), LCase(C), 0) <> 0 Then
            If Not Bool Then Acronyme = Acronyme & Ucase(C) & "."
            Bool = True
        Else
            Bool = False
        End If
    Next i
End Function

1619626357691.png


1619626435882.png
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 248
Messages
2 086 593
Membres
103 248
dernier inscrit
Happycat