XL 2021 traitement de texte

chingilou

XLDnaute Junior
bonsoir tout le monde
je voudrais si possible par formule au mieux ou par vba au pire epurer une rangée de moins de 200 lignes de textes en retirant les espaces superflues au début à la fin et au mileu du texte et aussi (c la mon probleme que je ne sais même pas comment refléchir a la solution) de mettre le texte en nompropre (majuscule de la 1er lettre ) si seulement le mot (le texte d'une cellule contient plus d'un mot 😁) contient plus de 3 lettres)
merci
 
Solution
Bonne nuit les noctambules ! bonne nuit @chingilou
Avec EXCEL 2021

en retirant les espaces superflues au début à la fin et au mileu du texte
Ça se fait avec la fonction SUPPRESPACE(" mon texte b ")


mettre le texte en nompropre (majuscule de la 1er lettre ) si seulement le mot (le texte d'une cellule contient plus d'un mot 😁) contient plus de 3 lettres)
Cette formule fait le boulot :
VB:
=JOINDRE.TEXTE(" ";VRAI;LET(Chaîne;" "&SUPPRESPACE(B4);Nb;NBCAR(Chaîne)-NBCAR(SUBSTITUE(Chaîne;" ";""));Marquage;SUBSTITUE(SUBSTITUE(Chaîne;" ";"¯";LIGNE(DECALER(Feuil1!$A$1;0;0;Nb;1)));"...

patricktoulon

XLDnaute Barbatruc
re
bonjour juste en passant
car je n'ai pas 2019 et donc pas certaine fonctions comme "joindre.texte" par exemple
VB:
Public Function textSpaceProper(Q As String)
    Dim A, I&
    Q = Application.Trim(Q): A = Split(Q, " ")
    For I = 0 To UBound(A)
        If Len(A(I)) > 3 Then A(I) = WorksheetFunction.Proper(A(I))
    Next
    textSpaceProper = Join(A, " ")
End Function
1684042926513.png
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour @patricktoulon, à tous les autres,

J'avais commencé donc je publie. J'ai essayé de tenir compte des expressions de type "(aa)" ou "s'en va" que je ne mets pas en ProperText() bien qu'ayant plus de 3 caractères.
  • On ôte les espaces devant et avant chaque ligne
  • On remplace les espaces multiples par un seul
  • On supprime les lignes vides en tête et queue de texte mais on conserve les lignes vides au sein du texte
  • On essaye de ne pas tenir compte de certains caractères spéciaux pour définir les mots de plus de 3 caractères
L'écriture d'un texte est si riche que dresser la liste exhaustive de tous les cas possibles est difficile. La fonction ProperText() est forcément imparfaite.
 

Pièces jointes

  • chingilou- formater texte- v2.xlsm
    19.5 KB · Affichages: 6

chingilou

XLDnaute Junior
bonjour
merci encore
j'ai trouvé le texte qui me posait probleme la derniere ligne vide ne partait pas et ça ne part pas avec la formule de attheone mais par contre ca marche avec la fonction de mapomme
et comment faire pour retirer les lignes vides du milieu (je hais les lignes vides) et les espaces à la fin des lignes
merci de même patrick
 

Pièces jointes

  • Exemple.xlsm
    20.5 KB · Affichages: 4

chingilou

XLDnaute Junior
Voir le fichier avec adaptation de la fonction ProperText().
rebonsoir les excelateurs de même mapomme
je voudrais te demander si tu permet concernant ta macro j'ai changé de tactique au lieu de séparer les mot de moins de 3 lettres de la fonctions proper j'essaie de faire du application.proper() sauf pour une partie de mots contenus dans une array par exemple qu'il reste tel quel ou bien entierement miniscule ou entierement majuscule ainsi que le <<l'>> ne soit pas touché mais le mot aprés le soit j'ai concue une macro qui fait l'affaire mais j'arrive pas l'incorporer dans ta fonction pour minimiser le temps
la macro :
VB:
Function Title$(ByVal ref As Range)
Dim c$,i%,j%,str$,vaArray As Variant, valcase as variant

    vaLCase = Array("ou", "et", "MDF", "HDD", _
      "SSD", "avec", "a", "ai", "au", "du", "de", "en", "F/P") 'j'ajouterais plus tard

    str = ""
    c = StrConv(ref, 3)
    'split the words into an array
    vaArray = Split(c, " ")
    For i = LBound(vaArray) To UBound(vaArray)
        For J = LBound(vaLCase) To UBound(vaLCase)
            If UCase(vaArray(i)) = UCase(vaLCase(J)) Then
            vaArray(i) = vaLCase(J)
            End If
        Next J
        If UCase(Left(vaArray(i), 2)) = UCase("l'") Then vaArray(i) = "l'" & StrConv((Mid(vaArray(i), 3, Len(vaArray(i)))), vbProperCase)
    str = str & " " & vaArray(i)
    Next i

str = ""
For i = LBound(vaArray) To UBound(vaArray)
str = str & " " & vaArray(i)
Next i
Title = Trim(str)
End Function
 

chingilou

XLDnaute Junior
pour ceux que ç'a interesse peut être voila une macro faite de la fonction de mapomme qui en principe réponds à mes attentes j'espere
VB:
Function ProperText$(ByVal x$)
Dim lignes, textes, vaLCase, res, iL&, j&, JJ%

    vaLCase = Array("ou", "et", "MDF", "HDD", _
      "SSD", "avec", "a", "ai", "au", "du", "de", "en", "F/P")
   lignes = Split(Application.Trim(x), Chr(10)) ' lines separated
   For iL = 0 To UBound(lignes)     'boucle au nombre de lignes
      If Trim(lignes(iL)) <> "" Then    'test lignes vides
         textes = Split(lignes(iL)) 'mots dans une sous-ligne
         For j = 0 To UBound(textes)    'boucle au nombre des mots dans une sous-ligne
    For JJ = LBound(vaLCase) To UBound(vaLCase) 'boucle au nombre des mots a exclure
    If UCase(textes(j)) = UCase(vaLCase(JJ)) Then
    textes(j) = vaLCase(JJ)
    JJ = UBound(vaLCase)
    Else: textes(j) = Application.Proper(textes(j))
    End If
    Next JJ
    'test si le mot commence par l' ou d'
    If UCase(Left(textes(j), 2)) = UCase("l'") Then textes(j) = "l'" & StrConv((Mid(textes(j), 3, Len(textes(j)))), vbProperCase)
    If UCase(Left(textes(j), 2)) = UCase("d'") Then textes(j) = "d'" & StrConv((Mid(textes(j), 3, Len(textes(j)))), vbProperCase)
    'test si la longueur des mots moins de 3 lettres
    'If Taille(textes(j)) > 3 Then textes(j) = Application.Proper(textes(j))
         Next j
         res = res & vbLf & Trim(Join(textes))
      End If
   Next iL
   Do
      iL = Len(res)
      If Left(res, 1) = vbLf Then res = Mid(res, 2)
      If Right(res, 1) = vbLf Then res = Left(res, Len(res) - 1)
   Loop Until iL = Len(res)
   res = Replace(res, vbLf & vbLf, "")
   ProperText = res
End Function
 

patricktoulon

XLDnaute Barbatruc
Bonsoir
juste en passant
je vois les choses plus simplement
VB:
Option Explicit
Function ProperText$(ByVal x$)
    Dim pastoucher, retouche, i&, EspacE$
'array de chaine qui ne doivent pas bouger
    pastoucher = Array("ou", "et", "MDF", "HDD", "SSD", "avec", "a", "ai", "au", "du", "de", "en", "F/P", "l'", "d'", "à")

 'le même array mais en proper
 retouche = Array("Ou", "Et", "Mdf", "Hdd", "Ssd", "Avec", "A", "Ai", "Au", "Du", "De", "En", "F/P", "L'", "D'", "À")
    
    x = Application.Proper(x) 'on met direct tout en proper
    
    For i = 0 To UBound(pastoucher) 'boucle sur l'array pastoucher
        
        If InStr(1, retouche(i), "'") Then EspacE = "" Else EspacE = " " 'on gere l'espace pour bien determiner un mot et non une partie demot
        
        x = Replace(x, EspacE & retouche(i) & EspacE, EspacE & pastoucher(i) & EspacE) 'on remplace ce qui a été modifier qui ne devait pas
        
        x = Replace(x, Chr(10) & retouche(i) & EspacE, Chr(10) & pastoucher(i) & EspacE) 'on gere ici le debut de ligne
    Next
    ProperText = x
End Function


Sub test()
    MsgBox ProperText("jean valjean au ski" & Chr(10) & "à la fou d'alos")
End Sub
1684953872410.png
 

Discussions similaires

Réponses
9
Affichages
416

Statistiques des forums

Discussions
311 725
Messages
2 081 941
Membres
101 848
dernier inscrit
Djigbenou