Discussion :

[patricktoulon]

re
et si on pouvait déterminer les x derniers caractères qui n'est pas un espace a droite ????( donc la fin de la chaîne valide )


j'ai choisi 3 mais ça peut-être plus

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=DROITE(SUPPRESPACE(A1);3)

ne pourrait -on pas faire quelque chose avec

[eriiic]

Re,

Ce qui ne te donnera rien de plus si ces caractères sont présents plusieurs fois.
eric

[RyuAutodidacte]

Salut Eric,

Merci pour les formules, je testerai dès que j'aurais un moment si possible, sinon ce sera ce soir.

@Patrick :

et si on pouvait déterminer les x derniers caractères qui n'est pas un espace a droite ????( donc la fin de la chaine valide )

La/les formule(s) que j'ai fait contient une partie déterminant le dernier mot (moins risqué que qq lettres, mais pas fiable à 100% si on a 2 x le même mot)
j'ai fait comme cela pour minimiser les risques - j’ai fait comme toi au début mais ça ne me convenait pas à cause du risque trop grand,
donc je suis tout à fait d'accord avec Eric
d'où ma recherche sur le nombre des derniers espaces en fin de texte ou une formule en faisant la même chose que StrReverse pour avoir les espaces à gauche dont la formule est simplissime

Edit : @Eric : Bingo je vais voir ce soir avec la 2ème formule pour voir ce que cela donne (formule surement plus courte au final ) merci =>

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=MAX(SI(STXT(A2;LIGNE(INDIRECT("$1:$"&NBCAR(A2)));1)<>" ";LIGNE(INDIRECT("$1:$"&NBCAR(A2)))))

[patricktoulon]

re
perso je me suis un peu amusé en rentrant tout a l'heure pour me détendre avec un regex sur un join de la transposition ; ca fonctionne
jusqu'à 20 espaces après le dernier caractères de chaque items

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Function RtrimAllCell(RnG)
    Dim Ligne, chaine$
    Ligne = Application.Transpose(RnG.Value)'conversion en array(1 dim)
    chaine = RTrim(Join(Ligne, ","))'   join tel quel avec le rtrim  juste pour supprimer le dernier espace ou groupe d'espace a la fin de la totalité de la chaine ( il ne sera pas vu par le regex )
    With CreateObject("VBScript.RegExp"):' pour le pattern c'est  de 1 a 20 espaces suivi d'une virgule  (pour le left la virgule serait devant )
        .Pattern = "(\s{1,20}),": RtrimAllCell = Application.Transpose(Split(.Replace(chaine, ","), ","))'on retranspose le split du replace du regex sur la chaine
    End With
End Function

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
 
Sub test()
    Dim DL, RnG As Range
    With Sheets(1)
        DL = .Cells(Rows.Count, 3).End(xlUp).Row
        Set RnG = .Range("C2:C" & DL)
          RnG.Value = RtrimAllCell(RnG)  'majuscule ou minuscule l'argument de propertie
    End With
End Sub

[RyuAutodidacte]

Coucou les amis,

@Eric : malheureusement je n'ai pas réussi à faire fonctionner ta formule (qui est top) en vba (je l'ai tenter aussi avec Ligne(Decaler … au lieu de Ligne(Indirect …)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=GAUCHE(A1;MAX(SI(STXT(A1;LIGNE(DECALER($A$1;0;0;NBCAR(A1);1));1)<>" ";LIGNE(DECALER($A$1;0;0;NBCAR(A1);1))))) ' Formule ok dans une cellule Excel - matricielle

Dans la fenêtre d'exécution :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

? Evaluate("LEFT(A1,MAX(IF(MID(A1,ROW(OFFSET($A$1,0,0,LEN(A1),1)),1)<>"" "",ROW(OFFSET($A$1,0,0,LEN(A1),1)))))") ' => OK

Ce que je me suis aperçu :

• les autres formules utilisées (avec UPPER, TRIM, etc …) sont des formules simples (non matricielles) => c'est OK

• la formule pour le RTrim est une formule matricielle on peut l'évaluer comme ci-dessus.
Mais quelque part cela me donne l'impression que l'on doit évaluer une matricielle qui elle utilise déjà une Evaluate pour fonctionner

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

      .Value = Evaluate("IF(ISTEXT(" & .Address & "),LEFT(" & .Address & ",MAX(IF(MID(" & .Address & ",ROW(OFFSET(" & .Address & ",0,0,LEN(" & .Address & "),1)),1)<>"" "",ROW(OFFSET(" & .Address & ",0,0,LEN(" & .Address & "),1))))),REPT(" & .Address & ",1))")

d'où le fait que cela ne marche pas. (à moins que ce soit autre chose ??)

Donc soit il existe une moyen d'évaluer une formule matricielle, soit on trouve le moyen d'obtenir le même résultat que ta formule avec une formule non matricielle … ou une autre formule …

@Tous
Qu'en pensez vous ? vos avis m'intéresse …

@Patrick : c'est bien le Regex, mais je ne suis pas chaud pour l'utiliser en vba
à la limite se serait plus rapide de faire un fichier texte avec les données à traiter et d'utiliser le Terminal OS X (Mac - commande Unix) qui a toutes les commandes requises pour faire tout ça ultra rapidement (par exemple avec sed)
Mais l'exercice est sympa sinon
Pour le regex ça ne serait pas plutôt un truc du genre (+ ou -)

Code regex :

Sélectionner tout - Visualiser dans une fenêtre à part

^.+\w(?!\+$)

[patricktoulon]

Bonjour ryu

^.+\w(?!\+$)

ca ca serait pultot pour le left sauf que tu utilise le start"^" qui doit se trouver en début de chaine hors il y en a (le nombre d'items)
je ne supprime par par item mais dans la chaine globale sinon le regex n'aurait aucun sens
voir même en y mettant tes conditionnels"|" se serait plutôt l'équivalent de App.trim

nous sommes ennuyés seulement par RTRIM le reste nous l'avons et ca fonctionne très bien

du reste le dollars qui stipule la fin de la chaine est en contradiction avec le start
et a aucun moment il est stipulé le (\s+) pour l'espace

notre problème est simple "(\s+)," pas la peine d'aller chercher des acrobatie avec les conditionnels et les subjections

re le résultat du join d'une colonne transposée avec des espaces en fin de cellules donnerait ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 Ligne = Application.Transpose(RnG.Value)'conversion en array(1 dim)
    chaine = RTrim(Join(Ligne, ","))'   join tel quel avec le rtrim  juste pour supprimer le dernier espace ou groupe d'espace a la fin de la totalité de la chaine ( il ne sera pas vu par le regex )

le trim join supprime les espace en fin de chaine complète
le regex se charge de supprimer les intermédiaire c'est tout

"toto ,titi ,riri ,fifififi "

" ," = "(\s+)," ou "(\s{1,20}),"

et attention a l'utilisation de la symbolique pour les caractères particuliers tes cellules pourrait très bien contenir des autres caractères particuliers ";.:! )etc....

[RyuAutodidacte]

Bonjour Patrick, mercatog, Eric,

@Patrick j'ai du oublié un "s" (j'ai pas testé), ^.+\w(?!\s+$) c'est normalement censé tout te prendre sauf les espaces à la fin comme le Rtrim

@tous : si cela vous dit quelques tests pour voir ce qui ok ou pas - merci d'avance. (PS : j'ai pas encore tout testé

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub test()
Dim Rng As Range, DL As Long, T!
    T = Timer
    With Sheets("Feuil3")
        DL = .Cells(.Rows.Count, 3).End(xlUp).Row
        Set Rng = .Range("C2:C" & DL)
    End With
    Clear_ATRimUpLoPro_LRTrim_InRange Rng, , , True
    MsgBox Format(Timer - T, "0.000 s")
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
' ********************************************************************************************************************************************************************************************************************************
' -----------------------------------------------------------  Clear_ATRimUpLoPro_LRTrim_InRange  -----------------------------------------------------------------------------
' ------------------------------------------------------------------------------------------------------------------------------------------------------------------------
 
'SUJET : suppersion des espace devant,apres et double espace dans les chaines dans une plage de cellules en un seul shoot
'AUTHOR : RyuAutodidacte sur develeoppez.com
'VERSION : 0.9 ßETA Tests
'DATE version :16/04/2019
'COMPATIBILITY: office Excel 32 bits (PC/MAC)
 
' Paramètres ________________________________________________________________________________________________________________
' 1 ) Range
' 2 ) OPTION -> Array(0, 1 , 2 , 3) au choix =>  "TRIM", "UPPER", "LOWER", "PROPER" -> mettre le  ou les chiffres souhaités (Attention ici le Trim correspond à Application.Trim)
' 3 ) OPTION -> True pour LTRIM ---> (PS : pour avoir le Trim normal mettre à True LTrim et RTrim)
' 4 ) OPTION -> True pour RTRIM ---> (PS : pour avoir le Trim normal mettre à True LTrim et RTrim)
 
' 5 ) OPTION x2  ->-> 2 Array pour supprimer les caratères voulus ==> CarSpe et SuppCarSpe
'      PS : Pour CarSpe et SuppCarSpe les Array doivent être de même hauteur (Action prioritaire sur les autres Options - mis à la fin pour plus de commodité)
'      ==> Faire correspondre les caractères à remplacer (CarSpe) par les nouveau caractères (SuppCarSpe) et de même hauteur
'      ==> Exemple :        N°1->  CarSpe --->  Array( "_", "Ø", "∞")       <===========>       N°2-> SuppCarSpe --->  Array( "|", "ø", "")                ---> au choix selon vos besoins
 
' ------------------------------------------   Grand Merci à Patrick (qui m'a poussé :D), Eric et mercatog pour l'aide et le soutien ;-)   -------------------------------------------------------
 
' PS : he oui ceux sont mes ParamArray et avec options en plus ^^ :D :D ;-)
' ********************************************************************************************************************************************************************************************************************************
 
Function Clear_ATRimUpLoPro_LRTrim_InRange(ByRef Rng As Range, Optional Param As Variant = Empty, Optional LT As Boolean, Optional RT As Boolean, Optional CarSpe As Variant = Empty, Optional SuppCarSpe As Variant = Empty)
Dim Adr As String, ChangeTxT(), M As Boolean
    ChangeTxT = Array("TRIM", "UPPER", "LOWER", "PROPER")
 
    Application.ScreenUpdating = False
    With Rng
        If Not IsEmpty(CarSpe) And Not IsEmpty(SuppCarSpe) Then
            If UBound(CarSpe) = UBound(SuppCarSpe) Then
                For i = LBound(CarSpe) To UBound(CarSpe):       .Replace CarSpe(i), SuppCarSpe(i):            Next
            ElseIf IsEmpty(CarSpe) Or IsEmpty(SuppCarSpe) Then
                M = True
            End If
        End If
        If M Then MsgBox "Nettoyage de la plage annulé" & vbCrLf & "Vérifier vos paramètres CarSpe et SuppCarSpe !":      Exit Function
 
        Adr = "'" & .Parent.Name & "'!" & .Address
        If Not IsEmpty(Param) And Application.Max(Param) < 4 And Application.Sum(Param) < 7 Then
            For i = LBound(Param) To UBound(Param)
                .Value = Evaluate("IF(ISTEXT(" & Adr & ")," & ChangeTxT(Param(i)) & "(" & Adr & "),REPT(" & Adr & ",1))")
            Next
        Else
            MsgBox "Problème de paramétrage dans ""Param""" & vbCrLf & "Vérifier l'Array svp":      Exit Function
        End If
 
        If LT Then .Value = Evaluate("IF(ISTEXT(" & Adr & "),MID(" & Adr & ",FIND(MID(TRIM(" & Adr & "),1,2)," & Adr & ",1),LEN(" & Adr & ")),REPT(" & Adr & ",1))")
        If RT Then .Value = Evaluate("IF(ISTEXT(" & .Address & "),LEFT(" & Adr & ",FIND(""^^"",SUBSTITUTE(" & Adr & ",RIGHT(TRIM(" & Adr & "),1),""^^"",LEN(" & Adr & ")-LEN(SUBSTITUTE(" & Adr & ",RIGHT(TRIM(" & Adr & "),1),""""))))),REPT(" & .Address & ",1))")
    End With
    Application.ScreenUpdating = True
End Function

[eriiic]

Bonjour à tous,

pour la formule qui ne fonctionne pas en vba, un nom s'évalue toujours en matriciel. A voir.

J'avais bien fait un test, mais pas forcément celui que tu attends ;-)
J'ai juste testé le gain potentiel sur un simple Ucase. 10 000 lignes de 32 car.
version réduite : 0.03 s
version If : 0.08 s
boucle sur un array : 0.06 s
Un gain n'existe que sur la version réduite, pas accessible à tout le monde, et de 3/100 s seulement (et 10000 lignes)...
Pour moi ça ne vaut pas le coup pour gagner 5 lignes de code.
Et d'où mon scepticisme encore plus grand sur les autres formules plus longues, quand on voit le coût des fonctions chaîne.
Ca ne restera qu'un exercice je pense :-)
eric

[RyuAutodidacte]

Hi Eric,

En fin de compte j’ai réussi à trouver une formule non matricielles (pas de moi) et peu plus courte pour le RTrim
J’ai fait qq tests vite fait non approfondi sur Mac 🖥 et pas encore sur PC.
Je suis peut-être passé à côté de petites chose vu que je l’ai à peine terminé tôt e matin.
J’ai pas cherché à gagner qq secondes mais plutôt avoir un côté pratique pour nettoyer et mettre en forme en parti du texte, sachant que l’on peut effectuer plusieurs actions en une fois et sans boucles (les seuls boucles sont des passages en paramètres pour lancer les actions).
Merci de ton retour je re plus tard (moins de temps en journée)

Édit : la formule est déjà dans le code de la function de mon post précédent.
Je viens de m’apercevoir que j’ai oublié de changer de des .address en adr

Edit 2 : j’ai testé sur Excel 2016 ++ le RTRIM ne marche pas comme sur Excel 2011 (Mac) du coup la formule n’est pas ok
@Eric : y a-t-il moyen de faire la même chose que ta formule sans matricielle forcé, mais avec sommeprod ???

[patricktoulon]

re

regarde ton pattern


essaie avec simplement "(\s+),"

tu ne peux pas employé "\W" dans ton pattern car il représente tout les caractères particuliers
.+\w(?!\s+$)

= , ; : ! / \ - ' etc.... etc....
pour un fichier .text je suis pas sur que cela soit plus rapide ca m'étonnerait

[RyuAutodidacte]

Re,

pour un fichier .text je suis pas sur que cela soit plus rapide ca m'étonnerait

Sur Mac avec les commandes unix du terminal t’as pas le temps de dire ouf 😅

[patricktoulon]

re
et oui mais combien de MAC pour combien de Windows ? ces commande la nous les avons pas
remarque c'est si facile de recupérer dans le clipboard une plage en format texte que .......(chose que j'ai déjà montré )

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Public Property Get presse_papier_Window() As String
presse_papier_Window = Replace(CreateObject("htmlfile").parentwindow.clipboardData.GetData("TEXT"), vbTab, " ")
End Property
Sub test()
Range("C2:C10").Copy
MsgBox presse_papier_Window
Application.CutCopyMode = False
End Sub

[RyuAutodidacte]

Re,

Edit 2 : j’ai testé sur Excel 2016 ++ le RTRIM ne marche pas comme sur Excel 2011 (Mac) du coup la formule n’est pas ok

En fait chose bizarre j'ai refait le test chez moi avec Excel Mac version 16.23 et la même formule sur RTRIM est OK (pourtant c'est l'office 365 de mon taf qui est installé chez moi, certes mis à jour …),
il doit y a voir une truc ????
Bon je vais corriger mon code et voir les petites correction/amélioration non encore faites

T'en pense quoi Patrick, 1er avis … ???

Edit : ok j'ai compris pourquoi, c'est les 2 .address que j'ai laissé dans mon code en début et fin de la formule qui fait que cela passé, si on remet Adr ça ne passe plus
Donc non en fait c'est pas bon erffff

[patricktoulon]

ben j'en pense quoi de quoi

j'essaie de comprendre ta dernière version avec param array tu t'es envolé la mais bon je l'ai juste survolé j'ai eu le smgbox verifier le pâram array

autrement dit si je comprends bien je suis obligé de choisir perso il n' y a que Rtrim qui m'intéresse les autre fonctionnant très bien pour 32/64 sous 2 versions différentes de formules pas la peine d'y revenir

elle est ou cette formule que tu veux que je teste


profite en ce soir j'ai 2007 ,2013 en 32 et 2016 64 sur pc portable

[RyuAutodidacte]

re,

autrement dit si je comprends bien je suis obligé de choisir perso il n' y a que Rtrim qui m'intéresse les autre fonctionnant très bien pour 32/64 sous 2 versions différentes de formules pas la peine d'y revenir
j'essaie de comprendre ta dernière version avec param array tu t'es envolé la mais bon je l'ai juste survolé j'ai eu le smgbox verifier le pâram array

non petite erreur en cours de correction=> tu peux choisir ce que tu veux indépendamment

Bon je vais corriger mon code et voir les petites correction/amélioration non encore faites

j'ai fais un edit ci-dessus

[patricktoulon]

re
testé sur 2007 ca marche
j'ai repris ta formule de la ligne "if RT......."

ps: tu avais laissé un ".address" au début je l'ai changé pour adr

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Sub testx()
Dim adr
 
    With Sheets("Feuil1")
        DL = .Cells(.Rows.Count, 3).End(xlUp).Row
        Set Rng = .Range("C2:C" & DL)
   adr = "'" & Rng.Parent.Name & "'!" & Rng.Address
 End With
    With Rng
        .Value = Evaluate("IF(ISTEXT(" & adr & "),LEFT(" & adr & ",FIND(""^^"",SUBSTITUTE(" & adr & ",RIGHT(TRIM(" & adr & "),1),""^^"",LEN(" & adr & ")-LEN(SUBSTITUTE(" & adr & ",RIGHT(TRIM(" & adr & "),1),""""))))),REPT(" & .Address & ",1))")
    End With
End Sub

je teste sur 2013

edit:
2013 32 OK

il est entendu que je fait mes tests sur la feuille concernée ET !!!! en entant sur une autre feuille activée

[RyuAutodidacte]

j'en ai oublié un à la fin aussi t'as pas lu mon Edit si tu le fais d'une autre feuille c'est pas bon et si tu mets Adr, je suppose que sur PC ca déconne aussi, fausse joie … ..????
.Value = Evaluate("IF(ISTEXT(" & adr & "),LEFT(" & adr & ",FIND(""^^"",SUBSTITUTE(" & adr & ",RIGHT(TRIM(" & adr & "),1),""^^"",LEN(" & adr & ")-LEN(SUBSTITUTE(" & adr & ",RIGHT(TRIM(" & adr & "),1),""""))))),REPT(" & .Address & ",1))")

PS : j'ai mis un collègue à contribution sur la formule

[patricktoulon]

c'est bon pour moi sur 2007 2013 32 pour tout

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Function ChangeAllCellpropertiesInRange(ByRef RnG As Range, prop As String)
    Dim R As Variant, Addr
    With RnG
        Addr = "'" & .Parent.Name & "'!" & .Address
        Select Case UCase(prop)
 
            'formule non matricielles
        Case "LOWER", "UPPER", "PROPER", "APPTRIM":
            prop = Replace(UCase(prop), "APPTRIM", "TRIM")
            R = Evaluate("IF(ISTEXT(" & Addr & ")," & UCase(prop) & "(" & Addr & "),REPT(" & Addr & ",1))")
 
            'formules matricielle
        Case "LTRIM": R = Evaluate("IF(ISTEXT(" & Addr & "),MID(" & Addr & ",FIND(MID(TRIM(" & Addr & "),1,2)," & Addr & ",1),LEN(" & Addr & ")),REPT(" & Addr & ",1))")
 
        Case "RTRIM": R = Evaluate("IF(ISTEXT(" & Addr & "),LEFT(" & Addr & ",FIND(""^^"",SUBSTITUTE(" & Addr & ",RIGHT(TRIM(" & Addr & "),1),""^^"",LEN(" & Addr & ")-LEN(SUBSTITUTE(" & Addr & ",RIGHT(TRIM(" & Addr & "),1),""""))))),REPT(" & .Address & ",1))")
 
        Case "TRIM": .Value = Evaluate("IF(ISTEXT(" & Addr & "),MID(" & Addr & ",FIND(MID(TRIM(" & Addr & "),1,2)," & Addr & ",1),LEN(" & Addr & ")),REPT(" & Addr & ",1))")
            R = Evaluate("IF(ISTEXT(" & Addr & "),MID(" & Addr & ",1,FIND(TRIM(RIGHT(SUBSTITUTE(TRIM(" & Addr & "), "" "", REPT("" "", 100)), 100))," & Addr & ",1)+LEN(TRIM(RIGHT(SUBSTITUTE(TRIM(" & Addr & "), "" "", REPT("" "", 100)), 100)))-1),REPT(" & Addr & ",1))")
        End Select
    End With
    ChangeAllCellpropertiesInRange = R
End Function
 
Sub test()
    Dim DL, RnG As Range
    With Sheets(1)
        DL = .Cells(Rows.Count, 3).End(xlUp).Row
        Set RnG = .Range("C2:C" & DL)
        'RnG.Parent.Activate
        RnG.Value = ChangeAllCellpropertiesInRange(RnG, "rTRIM")    'majuscule ou minuscule l'argument de propertie
    End With
End Sub

des que la pitchounette me laisse le portable je teste sur 2016

un dernier detail????
tu a laissé un ".address a la fin de la formule "Rtrim" pourquoi ???

oupss on c'est croisé ok pour le dernier on le laisse

[RyuAutodidacte]

Moi le dernier je ne laisserai pas, ça posera pb au final , comme je te l’ai dit c’est un oubli de ma part … la fatigue … je suis tenace donc tjs à la recherche de La Formule …

@Eric , oui j’ai bien noté ton idée sur l’évaluation du nom, a voir si ça vaut le coup … .
Merci 😉

[patricktoulon]

re
le dernier remplacé par addr ne fonctionne plus on a "#VALEUR"sur sheets actif ou pas c'est kif kif


et pareil sur 2013

autrement dit pour le dernier c'est une matrice qui est attendu même si c'est marqué et que ca marche avec ".address"

ou l'inverse les autres sont des matrices attendues et lui le string de l'address j'avoue que c'est obscure pour moi mais a mon avis le soucis est la

je dis soucis car visiblement ca ne fonctionne pas chez tout le monde chez moi OUI!!!