Macro à optimiser avec len et espace Résolu

Question

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

ccm81 · Answer

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

Dp5 · Answer

Bonjour,

Ca fonctionne, merci beaucoup.

lermite222 · Answer

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.

Macro à optimiser avec len et espace

3 réponses

Discussions similaires

Newsletters