Macro à optimiser avec len et espace

Résolu/Fermé
Dp5 - 11 mars 2011 à 18:12
lermite222 Messages postés 8724 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 - 14 mars 2011 à 11:58
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
A voir également:

3 réponses

ccm81 Messages postés 10903 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 19 novembre 2024 2 428
Modifié par ccm81 le 11/03/2011 à 18:57
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
0
Bonjour,

Ca fonctionne, merci beaucoup.
0
lermite222 Messages postés 8724 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
Modifié par lermite222 le 14/03/2011 à 12:23
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.
0