Réduire un champ trop long sans couper les mots ?

Réduire un champ trop long sans couper les mots ? - VB/VBA/VBS - Programmation

Marsh Posté le 20-02-2007 à 22:50:52    

Bonjour,
 
Je cherche en vain depuis plusieurs jours d'automatiser un traitement de fichiers sous Excel/VBA.
 
L'idée, c'est de séparer le contenue d'une cellule en deux lorsque le champ est trop long.
J'ai essayé avec la fonction NBCAR mais ça coupe les mots en plein milieu.
 
En faite, il me faudrait l'équivalent de la fonction "retour à la ligne automatique" mais exploitable dans deux cellules séparées au lieu d'un retour chariot dans la cellule.
 
J'ai trouvé un tuto pour séparer les adresses, villes et code postaux.
Mais les fichiers que je dois traiter sont des noms de personnes ou de sociétés et ça ne marche pas.
 
Je m'en remets à votre savoir.

Reply

Marsh Posté le 20-02-2007 à 22:50:52   

Reply

Marsh Posté le 21-02-2007 à 11:20:08    

Si la séparation doit intervenir entre les mots, utilise la fonction Split() qui sépare une chaine en plusieurs sous-chaines en fonction d'un caractère de séparation (ici ce serait l'espace).
 
À toi de voir comment ensuite regrouper ou dispatcher ces sous-chaines dans les cellules.

Reply

Marsh Posté le 22-02-2007 à 15:06:44    

Split marche effectivement bien sauf que tu ne peux pas déterminer à   quel le longueur couper la chaine de caractère : s'il y a pluieurs  "espaces" dans la chaine, par exemple.
 
En admettant que tes cellules sont toutes en colonne A, j'opterais   plutot pour un truc du type :
 
Sub split()
 
Dim i As Integer, a As Integer, b As Integer, j As Integer
Dim longueurmax As Integer, cpt As Integer
 
longueurmax = 50
j = 1
a = 1
b = 1
Do Until IsEmpty(Cells(a, b))
  Do While Len(Cells(a, b)) > longueurmax
    If InStr(Left(Cells(a, b), longueurmax), " " ) Then
      For i = 0 To longueurmax
        If Mid(Cells(a, b), longueurmax - i, 1) = " " Then
          Cells(a, b + j) = Right(Cells(a, b), Len(Cells(a, b)) - longueurmax + i)
          Cells(a, b) = Left(Cells(a, b), longueurmax - i - 1)
          b = b + 1
          Exit For
        End If
      Next i
    End If
  Loop
  b = 1
  a = a + 1
Loop
 
End Sub
 
Voila.

Reply

Marsh Posté le 22-02-2007 à 21:29:03    

Bonsoir,
l'utilisation de split me semble bonne aussi:
 
à moins que je me sois planté quelque part, ce qui n'est pas impossible
Sub sspplliitt()
Dim vase As String
longueur = 30
 
bout = Cells(65527, 1).End(xlUp).Row
avecespace = False ' true pour conserver les espaces en trop si nécessaire
 
For ligneencours = 1 To bout
sp = split(Cells(ligneencours, 1), " " )
u = UBound(sp)
j = 1
Cells(ligneencours, j) = ""
 For i = 0 To u
    trisp = Trim(sp(i))
    If trisp > "" Or avecespace Then
        If Len(Cells(ligneencours, j) & trisp) > longueur Then
        j = j + 1
        Cells(ligneencours, j) = ""
        End If
    Cells(ligneencours, j) = Cells(ligneencours, j) & trisp & " "
    sp(i)=""
    End If
 Next
Next
End Sub


Message édité par seniorpapou le 23-02-2007 à 06:56:32
Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed