Macro à optimiser avec len et espace

Résolu
Dp5 -  
Bonjour,

Quelqu'un aurait-il une solution pour optimiser cette macro (un peu barbare) ?

Le but est d'insérer un espace à une chaine de caractères (chiffres et lettres), tous les quatre caractères. Le nombre de caractère peut varier entre 1 et 95 environ, l'idéal serait qu'il n'y ait pas de limite.

Merci par avance.

Sub Test()

y = Len(ActiveCell.Value)

If y > 4 And y <= 8 Then
a = Mid(ActiveCell.Value, 1, 4) & " "
b = Mid(ActiveCell.Value, 5, 4)
ActiveCell.Value = (a) & (b)
ElseIf y > 8 And y <= 12 Then
a = Mid(ActiveCell.Value, 1, 4) & " "
b = Mid(ActiveCell.Value, 5, 4) & " "
c = Mid(ActiveCell.Value, 9, 4)
ActiveCell.Value = (a) & (b) & (c)
ElseIf y > 12 And y <= 16 Then
a = Mid(ActiveCell.Value, 1, 4) & " "
b = Mid(ActiveCell.Value, 5, 4) & " "
c = Mid(ActiveCell.Value, 9, 4) & " "
d = Mid(ActiveCell.Value, 13, 4)
ActiveCell.Value = (a) & (b) & (c) & (d)
ElseIf y > 16 And y <= 20 Then
a = Mid(ActiveCell.Value, 1, 4) & " "
b = Mid(ActiveCell.Value, 5, 4) & " "
c = Mid(ActiveCell.Value, 9, 4) & " "
d = Mid(ActiveCell.Value, 13, 4) & " "
e = Mid(ActiveCell.Value, 17, 4)
ActiveCell.Value = (a) & (b) & (c) & (d) & (e)
ElseIf y > 20 And y <= 24 Then
a = Mid(ActiveCell.Value, 1, 4) & " "
b = Mid(ActiveCell.Value, 5, 4) & " "
c = Mid(ActiveCell.Value, 9, 4) & " "
d = Mid(ActiveCell.Value, 13, 4) & " "
e = Mid(ActiveCell.Value, 17, 4) & " "
f = Mid(ActiveCell.Value, 21, 4)
ActiveCell.Value = (a) & (b) & (c) & (d) & (e) & (f)
ElseIf y > 24 And y <= 28 Then
a = Mid(ActiveCell.Value, 1, 4) & " "
b = Mid(ActiveCell.Value, 5, 4) & " "
c = Mid(ActiveCell.Value, 9, 4) & " "
d = Mid(ActiveCell.Value, 13, 4) & " "
e = Mid(ActiveCell.Value, 17, 4) & " "
f = Mid(ActiveCell.Value, 21, 4) & " "
g = Mid(ActiveCell.Value, 25, 4)
ActiveCell.Value = (a) & (b) & (c) & (d) & (e) & (f) & (g)
ElseIf y > 28 And y <= 32 Then
a = Mid(ActiveCell.Value, 1, 4) & " "
b = Mid(ActiveCell.Value, 5, 4) & " "
c = Mid(ActiveCell.Value, 9, 4) & " "
d = Mid(ActiveCell.Value, 13, 4) & " "
e = Mid(ActiveCell.Value, 17, 4) & " "
f = Mid(ActiveCell.Value, 21, 4) & " "
g = Mid(ActiveCell.Value, 25, 4) & " "
h = Mid(ActiveCell.Value, 29, 4)
ActiveCell.Value = (a) & (b) & (c) & (d) & (e) & (f) & (g) & (h)
ElseIf y > 32 And y <= 36 Then
a = Mid(ActiveCell.Value, 1, 4) & " "
b = Mid(ActiveCell.Value, 5, 4) & " "
c = Mid(ActiveCell.Value, 9, 4) & " "
d = Mid(ActiveCell.Value, 13, 4) & " "
e = Mid(ActiveCell.Value, 17, 4) & " "
f = Mid(ActiveCell.Value, 21, 4) & " "
g = Mid(ActiveCell.Value, 25, 4) & " "
h = Mid(ActiveCell.Value, 29, 4) & " "
i = Mid(ActiveCell.Value, 33, 4)
ActiveCell.Value = (a) & (b) & (c) & (d) & (e) & (f) & (g) & (h) & (i)
ElseIf y > 36 And y <= 40 Then
a = Mid(ActiveCell.Value, 1, 4) & " "
b = Mid(ActiveCell.Value, 5, 4) & " "
c = Mid(ActiveCell.Value, 9, 4) & " "
d = Mid(ActiveCell.Value, 13, 4) & " "
e = Mid(ActiveCell.Value, 17, 4) & " "
f = Mid(ActiveCell.Value, 21, 4) & " "
g = Mid(ActiveCell.Value, 25, 4) & " "
h = Mid(ActiveCell.Value, 29, 4) & " "
i = Mid(ActiveCell.Value, 33, 4) & " "
j = Mid(ActiveCell.Value, 37, 4)
ActiveCell.Value = (a) & (b) & (c) & (d) & (e) & (f) & (g) & (h) & (i) & (j)
ElseIf y > 40 And y <= 44 Then
a = Mid(ActiveCell.Value, 1, 4) & " "
b = Mid(ActiveCell.Value, 5, 4) & " "
c = Mid(ActiveCell.Value, 9, 4) & " "
d = Mid(ActiveCell.Value, 13, 4) & " "
e = Mid(ActiveCell.Value, 17, 4) & " "
f = Mid(ActiveCell.Value, 21, 4) & " "
g = Mid(ActiveCell.Value, 25, 4) & " "
h = Mid(ActiveCell.Value, 29, 4) & " "
i = Mid(ActiveCell.Value, 33, 4) & " "
j = Mid(ActiveCell.Value, 37, 4) & " "
k = Mid(ActiveCell.Value, 41, 4)
ActiveCell.Value = (a) & (b) & (c) & (d) & (e) & (f) & (g) & (h) & (i) & (j) & (k)
ElseIf y > 44 And y <= 48 Then
a = Mid(ActiveCell.Value, 1, 4) & " "
b = Mid(ActiveCell.Value, 5, 4) & " "
c = Mid(ActiveCell.Value, 9, 4) & " "
d = Mid(ActiveCell.Value, 13, 4) & " "
e = Mid(ActiveCell.Value, 17, 4) & " "
f = Mid(ActiveCell.Value, 21, 4) & " "
g = Mid(ActiveCell.Value, 25, 4) & " "
h = Mid(ActiveCell.Value, 29, 4) & " "
i = Mid(ActiveCell.Value, 33, 4) & " "
j = Mid(ActiveCell.Value, 37, 4) & " "
k = Mid(ActiveCell.Value, 41, 4) & " "
l = Mid(ActiveCell.Value, 45, 4)
ActiveCell.Value = (a) & (b) & (c) & (d) & (e) & (f) & (g) & (h) & (i) & (j) & (k) & (l)
End If

End Sub

3 réponses

  • Votes
  • Date
  • Date décroissante
  1. ccm81
    bonjour

    une fonction qui peut faire l'affaire (à mettre dans un module
    - s est la chaine a traiter
    - n est le nombre de caracteres entre deux espaces

    l'appel se fait par exemple

    A2 = Insere_espace(Range("A1").Value,4) 

    Public Function Insere_espace(ByVal s As String, n As Long) As String   
If Len(s) <= n Then   
  Insere_espace = s   
Else   
  Insere_espace = Left(s, n) & " " & Insere_espace(Right(s, Len(s) - n), n)   
End If   
End Function


    bonne suite

    RQ. j'ai supposé que la chaine a traiter ne contient pas d'espace, si ce n'est pas le cas, il faut la nettoyer avant de l'envoyer à Insere_espace
    2. lermite222 Contributeur
      Bonjour,
      Ou comme ça.. 
      Sub InsererSpace()   
Dim Mot As String, L As Integer  , M As String 
    Mot = ActiveCell.Value   
    For L =1 To Len(Mot) Step 4  
         M = M & Mid(Mot, L, 4) & " "   
    Next L   
    ActiveCell = M  
End Sub

      Ou encore, si tu veux en fonction... 
      Public Function InserSp(R As Range) 
Dim Mot As String, L As Integer, M As String 
    Mot = R.Value 
    For L = 1 To Len(Mot) Step 4 
        M = M & Mid(Mot, L, 4) & " " 
    Next L 
    InserSp = M 
End Function


      Exemple : le mot se trouve en B4 : =InserSp(B4)
      A+
      Toute la connaissance du monde ne peu tenir dans une seul tête (moi)
      Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius)
      NOTE : Je ne répond pas aux MP pour les questions techniques.
      Ça doit se passer sur le forum pour que tous puisse y participer ou en profiter.

      Discussions similaires

      comment accéder à mon compte sur le webmail aliceadsl.fr ?
      zird

      3 réponses