XL 2021 traitement de texte

[chingilou]

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

 

[patricktoulon]

re
bonjour juste en passant
car je n'ai pas 2019 et donc pas certaine fonctions comme "joindre.texte" par exemple

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

 

[mapomme]

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.

 

[chingilou]

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

 

[mapomme]

et comment faire pour retirer les lignes vides du milieu (je hais les lignes vides) et les espaces à la fin des lignes

Voir le fichier avec adaptation de la fonction ProperText().

 

[chingilou]

parfait milles merci mapomme

 

[chingilou]

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 :

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]

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

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]

Bonsoir
juste en passant
je vois les choses plus simplement

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