Colonne au format NOM propre

**patricktoulon** · 11/04/2019, 12h59

Bonjour RYU
ta dernière version TRIM fonctionne excel2007 W7

par contre effectivement ca fait la même chose que application.trim et non trim de vba

une solution???

**Philippe Tulliez** · 11/04/2019, 14h30

Bonjour RyuAutodidacte,
As-tu réelement testé tes codes ?
Sauf pour écrire la même valeur de la première à la dernière cellule, il n'est pas possible de transformer en majuscule, minuscule ou nom propre une plage complète avec le code des procédures PROPERTest, MajusculeTest et autres que tu proposes
La seule possibilité est de faire référence à une autre plage mais il ne me semble pas que ce soit la demande initiale

**RyuAutodidacte** · 11/04/2019, 16h04

Bonjour Philippe,

Comme signalé à Patrick, le résultat dépend de la version d'Excel utilisé, d'où la correction pour Patrick qui marche correctement.

Vba14 est lui sur Excel 2016 et à testé sans remonté de problème. (j'ai testé sur Excel 2016 Mac sans problème non plus avant de poster)

Alors oui j'ai testé sur Windows 10 Excel 2010 et on est dans le cas alors il faut utiliser le code dans la version plus longue comme Patrick pour Excel 2007.

Pour faire un récap :

Code en version Longue - Version d'Excel :
Windows : Excel 2007, 2010
Mac : Excel 2011

Code en version Courte - Version d'Excel :
Windows : Excel 2016 et ++
Mac : Excel 2016 et ++

Pour les autres versions je ne sais pas ce qu'il en est :

Envoyé par RyuAutodidacte

Apparemment, selon la version d'Excel cela ne réagit pas de la même façon, se serait bien de connaître les versions d'Excel ok et non ok avec le code dans sa version courte.

pour toi cela devrait marcher plutôt avec le code écrit comme ceci (version longue) - ici le Trim marche comme Application.Trim

Code :

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

1
2
3
4
5
6
Sub TrimAllCellInRange()
    DL = Cells(Rows.Count, 3).End(xlUp).Row
    With Range("C2:C" & DL)
        .Value = Evaluate("IF(ISTEXT(" & .Address & "),TRIM(" & .Address & "),REPT(" & .Address & ",1))")
    End With
End Sub

mercatog , si tu peux me dire la version d'Excel ou tu as testé le(s) code(s) se serait

EDIT : Si qq un peut tester avec la version d'Excel 2013 svp - merci d'avance

**patricktoulon** · 11/04/2019, 20h18

re
ce qui fonctionne sur 2007

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
 
Dim Dl As Long
Sub MajusculeTest()
    Dl = Cells(Rows.Count, 3).End(xlUp).Row
    With Range("C2:C" & Dl)
        '2007/2010
        .Value = Evaluate("IF(ISTEXT(" & .Address & "),UPPER(" & .Address & "),REPT(" & .Address & ",1))")
    End With
End Sub
Sub MinusculeTest()
    Dl = Cells(Rows.Count, 3).End(xlUp).Row
    With Range("C2:C" & Dl)
        '2007/2010
        .Value = Evaluate("IF(ISTEXT(" & .Address & "),LOWER(" & .Address & "),REPT(" & .Address & ",1))")
    End With
End Sub
Sub PROPERTest()
    Dl = Cells(Rows.Count, 3).End(xlUp).Row
    With Range("C2:C" & Dl)
        '2007/2010
        .Value = Evaluate("IF(ISTEXT(" & .Address & "),PROPER(" & .Address & "),REPT(" & .Address & ",1))")
    End With
End Sub
Sub TrimAllCellInRange()
'supprime tout les espaces avant et apres la chaine et tout les doubles espaces dans la chaine
    Dl = Cells(Rows.Count, 3).End(xlUp).Row
    With Range("C2:C" & Dl)
        .Value = Evaluate("IF(ISTEXT(" & .Address & "),TRIM(" & .Address & "),REPT(" & .Address & ",1))")
    End With
End Sub

est ce que la version longue fonctionne aussi sur les versions sup ?au quel cas la réponse est toute trouvée

**mercatog** · 11/04/2019, 20h26

Ruy Bonsoir

2013 version longue (boulot)

2016 version courte (maison)

En tout cas bravo pour l'astuce.

**RyuAutodidacte** · 12/04/2019, 09h23

Bonjour à tous,

Merci Vba14, Patrick, et mercatog (

pour la version 2013 qui me manquait

) => pour vos retour

Patrick, en effet ma 1ère réponse était sur la version longue, mais j'ai voulu testé sur Excel 2016 avec la version courte pour avoir une évaluation plus rapide.
Et là bingo sur la version 2016 et ++ ça marche. Donc autant ne pas s'en privé surtout que c'est plus simple à écrire et à se souvenir (à condition quel ne soit pas utilisé dans une version inferieure).

Mais sinon oui la version longue est à garder pour les autres versions en dessous de 2016 (on mettra la version 2003 dans le lot de la version longue)

Ce qui est bien c'est que l'on a pu faire le tour des versions d'Excel pour l'utilisation de ce code.

PS : pour l'utilisation du code V° longue (puisque marche avec toutes les V°), celui-ci a été utilisé dans le cas d'une plage contigüe,
il se peut que dans le cas d'une utilisation d'une plage discontinue, si vous rencontré un problème, il faudra alors l'appliqué dans une boucle For Each …Next sur les Areas

Code :

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

1
2
3
4
5
6
7
    ' … code …
        For Each AR In .Areas
            With AR
                .Value = Evaluate("IF(ISTEXT(" & .Address & "),TRIM(" & .Address & "),REPT(" & .Address & ",1))")
            End With
        Next
    ' … code …

concernant :

par contre effectivement ca fait la même chose que application.trim et non trim de vba

une solution???

pour l'instant non à moins d'avoir la formule Excel adéquate pour le transposer … … à trouver …

PS : je tiens juste à signaler qu'il y a des façons de faire plus simple et abordable pour des utilisateurs lambda avec le code de Jacques

(@unparia) qu'il avait proposé dans un post;
c'est un exemple, donc l'adapter à son contexte (idem pour PROPER, etc …):

Code :

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

1
2
3
4
5
6
7
8
Application.ScreenUpdating = False
 Columns(2).Insert
 With Range("B1:B" & Range("A" & Rows.Count).End(xlUp).Row)
  .Formula = "=TRIM(A1)"
  .Value = .Value
  Columns(1).Delete
 End With
Application.ScreenUpdating = True

**Vba14** · 12/04/2019, 09h40

Bonjour à tous,

Eh bien, j'étais loin de me douter qu'une simple question de mise en majuscules puisse absorber autant d'énergie et de réponses et aboutir à un tel sujet.

Merci chaleureusement à tous les participants, je vais garder précieusement cette discussion dans mes archives.

**RyuAutodidacte** · 13/04/2019, 23h33

Hi Patrick et le forum,

Envoyé par patricktoulon

Bonjour RYU
ta dernière version TRIM fonctionne excel2007 W7

par contre effectivement ca fait la même chose que application.trim et non trim de vba

une solution???

Pour le LTRIM ça été mais pour le RTRIM c'était plus galère car pour les formules ça va de gauche à droite, et forcément les formules sont plus longues surtout celle pour la droite

Est ce que ça vaut le coup, je n'en sais rien, car faudrait approfondir les tests…

Pour ton TRIM (et non Application.TRIM), utilisation de LTRIM et RTRIM (cause : longueur des formules)

Voilà les code dont le nom commence par PAT

:

Code :

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

1
2
3
4
5
6
Sub PATrimLeft()
    DL = Cells(Rows.Count, 3).End(xlUp).Row
    With Range("C2:C" & DL)
        .Value = Evaluate("IF(ISTEXT(" & .Address & "),MID(" & .Address & ",FIND(MID(TRIM(" & .Address & "),1,2)," & .Address & ",1),LEN(" & .Address & ")),REPT(" & .Address & ",1))")
    End With
End Sub

Code :

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

1
2
3
4
5
6
Sub PATrimRight()
    DL = Cells(Rows.Count, 3).End(xlUp).Row
    With Range("C2:C" & DL)
        .Value = Evaluate("IF(ISTEXT(" & .Address & "),MID(" & .Address & ",1,FIND(TRIM(RIGHT(SUBSTITUTE(TRIM(" & .Address & "), "" "", REPT("" "", 100)), 100))," & .Address & ",1)+LEN(TRIM(RIGHT(SUBSTITUTE(TRIM(" & .Address & "), "" "", REPT("" "", 100)), 100)))-1),REPT(" & .Address & ",1))")
    End With
End Sub

Code :

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

1
2
3
4
5
6
7
Sub PATrim()
    DL = Cells(Rows.Count, 3).End(xlUp).Row
    With Range("C2:C" & DL)
        .Value = Evaluate("IF(ISTEXT(" & .Address & "),MID(" & .Address & ",FIND(MID(TRIM(" & .Address & "),1,2)," & .Address & ",1),LEN(" & .Address & ")),REPT(" & .Address & ",1))")
        .Value = Evaluate("IF(ISTEXT(" & .Address & "),MID(" & .Address & ",1,FIND(TRIM(RIGHT(SUBSTITUTE(TRIM(" & .Address & "), "" "", REPT("" "", 100)), 100))," & .Address & ",1)+LEN(TRIM(RIGHT(SUBSTITUTE(TRIM(" & .Address & "), "" "", REPT("" "", 100)), 100)))-1),REPT(" & .Address & ",1))")
    End With
End Sub

Les formules :

Code :

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

1
2
3
4
5
6
7
  'GAUCHE
   =STXT(A1;TROUVE(STXT(SUPPRESPACE(A1);1;2);A1;1);NBCAR(A1)) ' FR
   =MID(A1,FIND(MID(TRIM(A1),1,2),A1,1),LEN(A1)) ' US/EN
 
  'DROITE
   =STXT(A1;1;TROUVE(SUPPRESPACE(DROITE(SUBSTITUE(SUPPRESPACE(A1); " "; REPT(" "; 100)); 100));A1;1)+NBCAR(SUPPRESPACE(DROITE(SUBSTITUE(SUPPRESPACE(A1); " "; REPT(" "; 100)); 100)))-1) ' FR
   =MID(A1,1,FIND(TRIM(RIGHT(SUBSTITUTE(TRIM(A1), " ", REPT(" ", 100)), 100)),A1,1)+LEN(TRIM(RIGHT(SUBSTITUTE(TRIM(A1), " ", REPT(" ", 100)), 100)))-1) ' US/EN

PS : si quelqu'un connait une formule Excel permettant de faire la même chose que StrReverse (vba), je pourrais conforter la formule pour la droite
Merci d'avance à la personne qui me donnera cette formule si c'est possible

**patricktoulon** · 14/04/2019, 08h59

re
ryu transformé en fonction et argument en "Range" ca ne fonctionne pas

j'ai réécrit tout les codes en fonction
regarde le commentaire de la sub test

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
'************************************************************************************************************************
'                                            LES PEPITES  de Ruyautodidacte                                             *
'                                                                                                                       *
'SUJET:suppersion des espace devant,apres et double espace dans les chaines dans une plage de cellules en un seul shoot *
'AUTHOR:Ruyautodidacte sur develeoppez.com                                                                              *
'VERSION :Beta 2019                                                                                                     *
'DATE version :14/04/2019                                                                                               *
'COMPATIBILITY: office Excel 32 bits                                                                                    *
'************************************************************************************************************************
Function PutUpperAllCellInRange(ByRef Rng As Range)
'mettre toute les cellule d'une plage en majuscule in one shoot
   With Rng
        .Value = Evaluate("IF(ISTEXT(" & .Address & "),UPPER(" & .Address & "),REPT(" & .Address & ",1))")
    End With
End Function
Function PutAllCellsInProperInRange(ByRef Rng As Range)
'mettre toute les cellules d'une plage en nom propre in one shoot
    With Rng
    .Value = Evaluate("PROPER(" & .Address & ")")
    End With
End Function
Function SupprfirstAndNexAndDoubleSpaceInRange(ByRef Rng As Range)
'supprime tout les espaces avant et apres la chaine et tout les doubles espaces dans la chaine in one shoot
    With Rng
    .Value = Evaluate("IF(ISTEXT(" & .Address & "),TRIM(" & .Address & "),REPT(" & .Address & ",1))")
    End With
End Function
 
Function TrimLeftAllCellsInRange(ByRef Rng As Range)
'supprime les espace devant le premier caracteres equivalent de "Ltrim" in one shoot
    withrng
    .Value = Evaluate("IF(ISTEXT(" & .Address & "),MID(" & .Address & ",FIND(MID(TRIM(" & .Address & "),1,2)," & .Address & ",1),LEN(" & .Address & ")),REPT(" & .Address & ",1))")
    End With
End Function
Function TrimRightAllCellsInRange(ByRef Rng As Range)
'supprime les espace apres le dernier caractere equivalent de "Rtrim" in one shoot
   With Rng
   .Value = Evaluate("IF(ISTEXT(" & .Address & "),MID(" & .Address & ",1,FIND(TRIM(RIGHT(SUBSTITUTE(TRIM(" & .Address & "), "" "", REPT("" "", 100)), 100))," & .Address & ",1)+LEN(TRIM(RIGHT(SUBSTITUTE(TRIM(" & .Address & "), "" "", REPT("" "", 100)), 100)))-1),REPT(" & .Address & ",1))")
    End With
End Function
 
Function TriMAllCellsInRange(ByRef Rng As Range)
'supprime les espace en debut et fin de chaine de  caracteres dans une plage  equivalent de "Ltrim" in one shoot
    With Rng
        .Value = Evaluate("IF(ISTEXT(" & .Address & "),MID(" & .Address & ",FIND(MID(TRIM(" & .Address & "),1,2)," & .Address & ",1),LEN(" & .Address & ")),REPT(" & .Address & ",1))")
        .Value = Evaluate("IF(ISTEXT(" & .Address & "),MID(" & .Address & ",1,FIND(TRIM(RIGHT(SUBSTITUTE(TRIM(" & .Address & "), "" "", REPT("" "", 100)), 100))," & .Address & ",1)+LEN(TRIM(RIGHT(SUBSTITUTE(TRIM(" & .Address & "), "" "", REPT("" "", 100)), 100)))-1),REPT(" & .Address & ",1))")
    End With
End Function
Sub test()
    Dim DL, Rng As Range
    DL = Cells(Rows.Count, 3).End(xlUp).Row
    Set Rng = Sheets(1).Range("C2:C" & DL)
    TriMAllCellsInRange (Sheets(1).Range("C2:C" & DL))
    'TriMAllCellsInRange (RnG)     ne fonctionne pas ??????????????????????????????????? object requis ????????
End Sub

par contre si j'utilise la fonction en tant que return Rng ne plante pas
ca devrait pas avoir cette incidence non?

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
Function TriMAllCellsInRange(ByRef Rng As Range)
'supprime les espace en debut et fin de chaine de  caracteres dans une plage  equivalent de "Ltrim" in one shoot
    With Rng
        .Value = Evaluate("IF(ISTEXT(" & .Address & "),MID(" & .Address & ",FIND(MID(TRIM(" & .Address & "),1,2)," & .Address & ",1),LEN(" & .Address & ")),REPT(" & .Address & ",1))")
        TriMAllCellsInRange = Evaluate("IF(ISTEXT(" & .Address & "),MID(" & .Address & ",1,FIND(TRIM(RIGHT(SUBSTITUTE(TRIM(" & .Address & "), "" "", REPT("" "", 100)), 100))," & .Address & ",1)+LEN(TRIM(RIGHT(SUBSTITUTE(TRIM(" & .Address & "), "" "", REPT("" "", 100)), 100)))-1),REPT(" & .Address & ",1))")
    End With
End Function
Sub test()
    Dim DL, Rng As Range
    DL = Cells(Rows.Count, 3).End(xlUp).Row
    Set Rng = Sheets(1).Range("C2:C" & DL)
 
    Rng.Value = TriMAllCellsInRange(Rng)
 
 
    'TriMAllCellsInRange (Sheets(1).Range("C2:C" & DL))
    'TriMAllCellsInRange (RnG)     ne fonctionne pas ??????????????????????????????????? object requis ????????
End Sub

**RyuAutodidacte** · 14/04/2019, 14h19

Patrick,

Oui c'est bizarre ton problème, en espérant que c'est OK, je me suis mis sur Windows 10 et Excel 2010 pour tester,
avec les codes ci-dessous, je n'ai pas eu de problème apparent
PS : l'activation de la feuille est voulue car cela peut poser problème - mais j'en ai pas encore déterminé la cause (si on est sur une feuille différente cela peut effacer les données)
Pour tester j'ai garder la même range et changé le nom de la fonction dans la Sub test :

Edit : Aux testeurs, dites ce que cela donne chez vous en précisant la version d'Excel et Windows svp - Merci
(J'ai testé sur presque 100 000 lignes on est aux alentours de 0.7 s + ou - (sur ma config) sauf pour RTRIM_CellsInRange dont la formule est plus longue environ 2 s et des poussières, LTRIM_CellsInRange étant en dessous de la seconde)

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(1)
        DL = .Cells(.Rows.Count, 3).End(xlUp).Row
        Set Rng = .Range("C2:C" & DL)
    End With
    AppTRIM_CellsInRange Rng
    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
Function AppTRIM_CellsInRange(ByRef Rng As Range)
    Application.ScreenUpdating = False
    With Rng
        .Parent.Activate
        .Value = Evaluate("IF(ISTEXT(" & .Address & "),TRIM(" & .Address & "),REPT(" & .Address & ",1))")
    End With
    Application.ScreenUpdating = True
End Function

Code :

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

1
2
3
4
5
6
7
8
9
Function TRIM_CellsInRange(ByRef Rng As Range)
    Application.ScreenUpdating = False
    With Rng
        .Parent.Activate
        .Value = Evaluate("IF(ISTEXT(" & .Address & "),MID(" & .Address & ",FIND(MID(TRIM(" & .Address & "),1,2)," & .Address & ",1),LEN(" & .Address & ")),REPT(" & .Address & ",1))")
        .Value = Evaluate("IF(ISTEXT(" & .Address & "),MID(" & .Address & ",1,FIND(TRIM(RIGHT(SUBSTITUTE(TRIM(" & .Address & "), "" "", REPT("" "", 100)), 100))," & .Address & ",1)+LEN(TRIM(RIGHT(SUBSTITUTE(TRIM(" & .Address & "), "" "", REPT("" "", 100)), 100)))-1),REPT(" & .Address & ",1))")
    End With
    Application.ScreenUpdating = True
End Function

Code :

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

1
2
3
4
5
6
7
8
Function LTRIM_CellsInRange(ByRef Rng As Range)
    Application.ScreenUpdating = False
    With Rng
        .Parent.Activate
        .Value = Evaluate("IF(ISTEXT(" & .Address & "),MID(" & .Address & ",FIND(MID(TRIM(" & .Address & "),1,2)," & .Address & ",1),LEN(" & .Address & ")),REPT(" & .Address & ",1))")
    End With
    Application.ScreenUpdating = True
End Function

Code :

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

1
2
3
4
5
6
7
8
Function RTRIM_CellsInRange(ByRef Rng As Range)
    Application.ScreenUpdating = False
    With Rng
        .Parent.Activate
        .Value = Evaluate("IF(ISTEXT(" & .Address & "),MID(" & .Address & ",1,FIND(TRIM(RIGHT(SUBSTITUTE(TRIM(" & .Address & "), "" "", REPT("" "", 100)), 100))," & .Address & ",1)+LEN(TRIM(RIGHT(SUBSTITUTE(TRIM(" & .Address & "), "" "", REPT("" "", 100)), 100)))-1),REPT(" & .Address & ",1))")
    End With
    Application.ScreenUpdating = True
End Function

Code :

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

1
2
3
4
5
6
7
8
Function UPPER_CellsInRange(ByRef Rng As Range)
    Application.ScreenUpdating = False
    With Rng
        .Parent.Activate
        .Value = Evaluate("IF(ISTEXT(" & .Address & "),UPPER(" & .Address & "),REPT(" & .Address & ",1))")
    End With
    Application.ScreenUpdating = True
End Function

Code :

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

1
2
3
4
5
6
7
8
Function LOWER_CellsInRange(ByRef Rng As Range)
    Application.ScreenUpdating = False
    With Rng
        .Parent.Activate
        .Value = Evaluate("IF(ISTEXT(" & .Address & "),LOWER(" & .Address & "),REPT(" & .Address & ",1))")
    End With
    Application.ScreenUpdating = True
End Function

Code :

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

1
2
3
4
5
6
7
8
Function PROPER_CellsInRange(ByRef Rng As Range)
    Application.ScreenUpdating = False
    With Rng
        .Parent.Activate
        .Value = Evaluate("IF(ISTEXT(" & .Address & "),PROPER(" & .Address & "),REPT(" & .Address & ",1))")
    End With
    Application.ScreenUpdating = True
End Function

**patricktoulon** · 14/04/2019, 15h38

re
en fait il faut l'utiliser comme un fonction est sensée fonctionner
a savoir en exploitant le Return dans la sub test
et effectivement il faut que la feuille soit active non pas pour le bug mais pour l'effet qui ne se fait pas si on est pas sur la feuille concernée(ca c'est un moins)

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
'************************************************************************************************************************
'                                            LES PEPITES  de Ruyautodidacte                                             *
'                                                                                                                       *
'SUJET:suppersion des espace devant,apres et double espace dans les chaines dans une plage de cellules en un seul shoot *
'AUTHOR:Ruyautodidacte sur develeoppez.com                                                                              *
'VERSION :Beta 2019                                                                                                     *
'DATE version :14/04/2019                                                                                               *
'COMPATIBILITY: office Excel 32 bits                                                                                    *
'************************************************************************************************************************
'
Function PutUpperAllCellInRange(ByRef Rng As Range)
'mettre toute les cellule d'une plage en majuscule in one shoot
    With Rng
        PutUpperAllCellInRange = Evaluate("IF(ISTEXT(" & .Address & "),UPPER(" & .Address & "),REPT(" & .Address & ",1))")
    End With
End Function
'
Function PutAllCellsInProperInRange(ByRef Rng As Range)
'mettre toute les cellules d'une plage en nom propre in one shoot
    With Rng
        PutAllCellsInProperInRange = Evaluate("PROPER(" & .Address & ")")
    End With
End Function
'
Function SupprfirstAndNexAndDoubleSpaceInRange(ByRef Rng As Range)
'supprime tout les espaces avant et apres la chaine et tout les doubles espaces dans la chaine in one shoot
    With Rng
        SupprfirstAndNexAndDoubleSpaceInRange = Evaluate("IF(ISTEXT(" & .Address & "),TRIM(" & .Address & "),REPT(" & .Address & ",1))")
    End With
End Function
' 
Function TrimLeftAllCellsInRange(ByRef Rng As Range)
'supprime les espace devant le premier caracteres equivalent de "Ltrim" in one shoot
    withrng
    TrimLeftAllCellsInRange = Evaluate("IF(ISTEXT(" & .Address & "),MID(" & .Address & ",FIND(MID(TRIM(" & .Address & "),1,2)," & .Address & ",1),LEN(" & .Address & ")),REPT(" & .Address & ",1))")
End With
End Function
'
Function TrimRightAllCellsInRange(ByRef Rng As Range)
'supprime les espace apres le dernier caractere equivalent de "Rtrim" in one shoot
    With Rng
        TrimRightAllCellsInRange = Evaluate("IF(ISTEXT(" & .Address & "),MID(" & .Address & ",1,FIND(TRIM(RIGHT(SUBSTITUTE(TRIM(" & .Address & "), "" "", REPT("" "", 100)), 100))," & .Address & ",1)+LEN(TRIM(RIGHT(SUBSTITUTE(TRIM(" & .Address & "), "" "", REPT("" "", 100)), 100)))-1),REPT(" & .Address & ",1))")
    End With
End Function
'
Function TriMAllCellsInRange(ByRef Rng As Range)
'supprime les espace en debut et fin de chaine de  caracteres dans une plage  equivalent de "Ltrim" in one shoot
    With Rng
        .Value = Evaluate("IF(ISTEXT(" & .Address & "),MID(" & .Address & ",FIND(MID(TRIM(" & .Address & "),1,2)," & .Address & ",1),LEN(" & .Address & ")),REPT(" & .Address & ",1))")
        TriMAllCellsInRange = Evaluate("IF(ISTEXT(" & .Address & "),MID(" & .Address & ",1,FIND(TRIM(RIGHT(SUBSTITUTE(TRIM(" & .Address & "), "" "", REPT("" "", 100)), 100))," & .Address & ",1)+LEN(TRIM(RIGHT(SUBSTITUTE(TRIM(" & .Address & "), "" "", REPT("" "", 100)), 100)))-1),REPT(" & .Address & ",1))")
    End With
End Function

la sub pour tester

Code :

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

1
2
3
4
5
6
7
8
'
'
Sub test()
    Dim DL, Rng As Range
    DL = Cells(Rows.Count, 3).End(xlUp).Row
    Set Rng = Sheets(1).Range("C2:C" & DL)
      Rng.Value = TrimRightAllCellsInRange(Rng)
End Sub

fonctionne avec toute les fonction sur 2007 et 2013 32 bits

**RyuAutodidacte** · 14/04/2019, 15h42

en fait il faut l'utiliser comme un fonction est sensée fonctionner
a savoir en exploitant le Return dans la sub test

Sinon ça ne marche pas sur ta version 2007 ??

**patricktoulon** · 14/04/2019, 16h00

si la feuille n'est pas active non

**mercatog** · 14/04/2019, 16h30

Bonjour

Sans activer la feuille, il faudra mettre l'adressage complet

Code :

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

1
2
3
4
5
6
7
8
Function AppTRIM_CellsInRange(ByRef Rng As Range)
Dim Adr As String
 
With Rng
    Adr = "'" & .Parent.Name & "'!" & .Address
    .Value = Evaluate("IF(ISTEXT(" & Adr & "),TRIM(" & Adr & "),REPT(" & Adr & ",1))")
End With
End Function

**Vba14** · 14/04/2019, 16h34

Bonjour,

Il y a bien longtemps que j'ai décroché, car je ne suis plus suffisamment compétent pour tout comprendre. Je vais relire toute la discussion à tête reposée.

Elle a eu le mérite de faire écrire des lignes

**patricktoulon** · 14/04/2019, 17h06

Envoyé par mercatog

Bonjour

Sans activer la feuille, il faudra mettre l'adressage complet

Code :

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

1
2
3
4
5
6
7
8
Function AppTRIM_CellsInRange(ByRef Rng As Range)
Dim Adr As String
 
With Rng
    Adr = "'" & .Parent.Name & "'!" & .Address
    .Value = Evaluate("IF(ISTEXT(" & Adr & "),TRIM(" & Adr & "),REPT(" & Adr & ",1))")
End With
End Function

on a eu la même idée Mercatog sauf que je n'y sui pas arrivé il me manquait les simples quotes (bon sang mais c'est bien sur

)
j'avais fait

Code :

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

 Addr=rng.parent.codename &"!" & rng.address

je vais vérifier si je peux l'intégrer j'ai réduit le tout a une seule fonction

le pauvre vba14 il doit avoir mal aux yeux

**RyuAutodidacte** · 14/04/2019, 17h08

mercatog,

bien vu

pourquoi faire compliqué alors que l'on peut faire simple ...

**patricktoulon** · 14/04/2019, 17h14

re ca ne fonctionne pas Mercatog 2013 32
la fonction tout en un

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
 
Function ChangeAllCellpropertiesInRange(ByVal RnG As Range, prop As String)
    Dim R As Variant, Addr
    With RnG
        Addr = "'" & .Parent.Name & "'!" & .Address
        Select Case UCase(prop)
        Case "LOWER": R = Evaluate("IF(ISTEXT(" & .Address & "),UPPER(" & Addr & "),REPT(" & Addr & ",1))")
        Case "UPPER": R = Evaluate("IF(ISTEXT(" & Addr & "),LOWER(" & Addr & "),REPT(" & Addr & ",1))")
        Case "PROPER": R = Evaluate("IF(ISTEXT(" & Addr & "),PROPER(" & Addr & "),REPT(" & Addr & ",1))")
        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 & "),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))")
        Case APPTRIM: R = Evaluate("IF(ISTEXT(" & Addr & "),TRIM(" & Addr & "),REPT(" & Addr & ",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

la sub

Code :

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

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

en même temps je pense pas que ca puisse fonctionner la chaine attendu a la place ad Addr est une address pas un range
donc que tu lui mette "Feuil1!$C$4:$C$10" ou $C$4:$C$10 le résultat sera le même seule l'adresse est prise en compte pas le parent donc non c'est pas bon : je cherche

et puis RTRIM,TRIM,APPTRIM ne fonctionne plus J'AI SOIT #VALEUR SOIT #NOM? A LA PLACE DES VALEURS

**RyuAutodidacte** · 14/04/2019, 17h27

Re,

Patrick :

re ca ne fonctionne pas Mercatog 2013 32

C'est quoi qui ne fonctionne pas ??

**patricktoulon** · 14/04/2019, 17h48

re
test ca en changeant l'argument
ce qui ne fonctionne plus
trim, apptrim ,rtrim

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
Function ChangeAllCellpropertiesInRange(ByRef RnG As Range, prop As String)
    Dim R As Variant, Addr
    With RnG
        Addr = "'" & .Parent.Name & "'!" & .Address
        Select Case UCase(prop)
        Case "LOWER", "UPPER", "PROPER", "APPTRIM":
            R = Evaluate("IF(ISTEXT(" & .Address & ")," & UCase(prop) & "(" & Addr & "),REPT(" & Addr & ",1))")
 
        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 & "),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))")
 
 
        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
    DL = Cells(Rows.Count, 3).End(xlUp).Row
    Set RnG = Sheets(1).Range("C2:C" & DL)
    'RnG.Parent.Activate
    RnG.Value = ChangeAllCellpropertiesInRange(RnG, "APPTRIM")    'majuscule ou minuscule l'argument de propertie
End Sub

pour APPTRIM j'ai ajouter ca en debut de fonction prop = Replace(UCase(prop), "APPTRIM", "TRIM")
mais ca marche plus quand meme

Colonne au format NOM propre [XL-2016]

Macros et VBA Excel

Discussions similaires

Partager

Partager