Insertion de caractères dans une cellule en VBA

jeff1494

XLDnaute Occasionnel
Bonjour à toutes et tous;
Je reviens vers vous car je dois modifier la valeur d'une cellule contenant la chaine de caractères suivants:
[[-11],[-1-1],[1-1],[11]]​
La transformation est d'insérer une virgule et un espace après chaque 1er chiffre entre crochet, ce qui doit donner la chaine suivante :
[[-1, 1],[-1, -1],[1, -1],[1, 1]]​

J'avoue que je ne sais pas comment appréhender le problème.
Donc y-aurait-il quelqu'un pour m'expliquer comment le faire?

D'avance je remercie ceux qui voudront bien se pencher sur mon problème.
Bonne soirée à toutes et tous.
 

jeff1494

XLDnaute Occasionnel
Bonsoir Sylvanu,
Je te remercie pour ton aide, mais en fait cette chaine de caractères n'est pas toujours la même et donc le SUBSTITUTE ne marchera pas.
Voici un autre exemple de chaine que je peux trouver :
[[-20, 10], [10, 10], [10, -10], [-20, -10]], et la manipulation doit être la même.
Existe-t-il un moyen de découper la valeur en sous-ensembles, puis d'intervenir sur les sous-ensembles qui m'intéressent?
Dans une vie antérieure ( il y a 40 ans) je développais sur des machines en RPG, et on avait cette possibilité, qui était très intéressante.
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonsoir @jeff1494,

Avec une fonction personnalisée dont le code est dans Module1:
VB:
Function AjouterSep(x, sep)
Dim s, i&
s = Split(x, ",")
For i = 0 To UBound(s)
   If Left(s(i), 2) = "[[" Then
      If Mid(s(i), 3, 1) = "-" Then
         s(i) = Left(s(i), 4) & sep & Mid(s(i), 5)
      Else
         s(i) = Left(s(i), 3) & sep & Mid(s(i), 4)
      End If
   Else
      If Mid(s(i), 2, 1) = "-" Then
         s(i) = Left(s(i), 3) & sep & Mid(s(i), 4)
      Else
         s(i) = Left(s(i), 2) & sep & Mid(s(i), 3)
      End If
   End If
Next i
AjouterSep = Join(s, ",")
End Function

Nota : x est la chaine à traiter, sep est le séparateur à utiliser (virgule pour votre demande ou virgule suivi d'un espace ou autre chose))
 

Pièces jointes

  • jeff1494- insérer séparateur- v1.xlsm
    17.1 KB · Affichages: 8

sousou

XLDnaute Barbatruc
Bonjour à tous
La mienne ;)
Dim rangt()
Function modif(cel)

Set c = cel
nbc = Len(c)
For n = 1 To nbc
v = Mid(c, n, 1)
If v = "[" Then flag = 1
If IsNumeric(v) = True And flag = 1 Then
compte = compte + 1
ReDim Preserve rangt(compte)
rangt(compte) = n
flag = 0
End If



Next
For n = 1 To UBound(rangt)
g = Left(c, rangt(n) + n - 1) & ","
d = Right(c, Len(c) - Len(g) + 1)
c = g & d
Next
modif = c
End Function
 

jeff1494

XLDnaute Occasionnel
Pour mapomme;
Votre fonction fonctionne très bien si je n'ai qu'un seul chiffre soit par exemple [[-11],[-1-1],[1-1],[11]] le résultat est correct [[-1, 1],[-1, -1],[1, -1],[1, 1]]

Par contre pour cette combinaison [[-20, 10], [10, 10], [10, -10], [-20, -10]] , le résultat est [[-2, 010],[1, 010],[1, 0-10],[-2, 0-10]]. Le problème vient du fait d'avoir un nombre à deux chiffres par exemple -20.
Malheureusement je n'ai aucun moyen de prédire ce que j'aurai dans la cellule. La forme sera toujours la même, mais je peux avoir que des chiffres ou bien que des nombres à deux chiffres, voire même un panachage nombre et chiffres.

Mais dans tous les cas je vous remercie pour votre aide.
 

jeff1494

XLDnaute Occasionnel
Bonjour sousou;
En fait j'ai le même problème. Voici comment j'appelle la fonction dans mon code VBA :

VB:
Dim retourfonction
Dim cel As String
cel = Range("B" & Ligref).Value
retourfonction = modif(cel)

En effet quand je regarde ton fichier, cela fonctionne très bien. Je pense donc que cela vient de mon fait. Je ne suis pas habitué à travailler avec des fonctions, et peut-être que je ne m'y prend pas bien.
Voici donc tout le code de la procédure qui appelle ta fonction.
VB:
Private Sub valdef(Valeurcellule As String)
Dim Nbcarac As Integer
Dim nc As Integer
Dim cel As String
Dim retourfonction As String

                    Worksheets("Resref").Select
                    Range("B" & Ligref).Select
                    ' Test si traitement polygones
                    If Cellprecedente Like "*polygon*" Then
                        'MsgBox "Polygon trouvé"
                        valeur_polygones = ""
                        Call polygon
                        Worksheets(2).Select
                        Range("B" & Ligref).Value = valeur_polygones
                        nc = Len(Range("B" & Ligref).Value)
                        Range("B" & Ligref).Value = Left(Range("B" & Ligref).Value, nc - 1)
     ' Appel fonction
                        cel = Range("B" & Ligref).Value
                        retourfonction = modif(cel)
                        Range("B" & Ligref).Value = retourfonction
                        Range("B" & Ligref).Value = Replace(Range("B" & Ligref), ",[", ", [")
                        GoTo Suite1
                    End If
                   
                    ' Mise en forme de la valeur
                    Range("B" & Ligref).Value = Trim(Valeurcellule)                                            ' Supprime les espaces en début de cellule
                    Range("B" & Ligref).Value = Replace(Range("B" & Ligref), "default_value", "")              ' Remplace le texte label par rien, donc les supprime
                    Range("B" & Ligref).Value = Replace(Range("B" & Ligref), """", "")                         ' Remplace les " par rien, donc les supprime
                    Range("B" & Ligref).Value = Replace(Range("B" & Ligref), ": ", "")                         ' Remplace le : par rien, donc les supprime
                        If Range("B" & Ligref).Value Like "*false*" Then
                            Range("B" & Ligref).Value = "'" & Replace(Range("B" & Ligref), ",", "")
                            GoTo Suite
                        End If
                        If Range("B" & Ligref).Value Like "*true*" Then
                            Range("B" & Ligref).Value = "'" & Replace(Range("B" & Ligref), ",", "")
                            GoTo Suite
                        End If
                    Range("B" & Ligref).Value = Replace(Range("B" & Ligref), ",", "")                          ' Remplace la , par rien donc supprime la ,
Suite:
                    If IsNumeric(Range("B" & Ligref)) Then
                        Nbcarac = Len(Range("B" & Ligref).Value)
                        If Nbcarac > 10 Then
                            Range("B" & Ligref).NumberFormat = "0"                                      ' On formate la colonne avec chiffres après virgule seulement si ils existent
                        Else
                            Range("B" & Ligref).NumberFormat = "General"
                        End If
                    End If
                    Range("B" & Ligref).HorizontalAlignment = xlCenter                                                ' On centre les données dans la colonne
Suite1:
                    Worksheets(1).Select

End Sub

En fait l'appel est fait dans le premier IF (If Cellprecedente Like "*polygon*" Then).

Si tu as besoin de plus d'informations n'hésites pas à me le dire.
Encore merci pour ton aide, et bonne journée.
 

Discussions similaires

Statistiques des forums

Discussions
314 611
Messages
2 111 145
Membres
111 051
dernier inscrit
MANUREVALAND