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???
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???
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
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
Philippe Tulliez
Ce que l'on conçoit bien s'énonce clairement, et les mots pour le dire arrivent aisément. (Nicolas Boileau)
Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter
Mes tutoriels : Utilisation de l'assistant « Insertion de fonction », Les filtres avancés ou élaborés dans Excel
Mon dernier billet : Utilisation de la fonction Dir en VBA pour vérifier l'existence d'un fichier
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 :
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
Cordialement
Ryu
La connaissance s’acquiert par l’expérience, tout le reste n’est que de l’information. – Albert Einstein
Pensez à la Balise [ CODE][/CODE ] - à utiliser via le bouton # => Exemple
Une fois votre problème solutionné pensez à mettre en n'oubliant pas d'indiquer qu'elle est la solution finale choisie
re
ce qui fonctionne sur 2007
est ce que la version longue fonctionne aussi sur les versions sup ?au quel cas la réponse est toute trouvée
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
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
Ruy Bonsoir
2013 version longue (boulot)
2016 version courte (maison)
En tout cas bravo pour l'astuce.
Cordialement.
J'utilise toujours le point comme séparateur décimal dans mes tests.
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
concernant :
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
pour l'instant non à moins d'avoir la formule Excel adéquate pour le transposer … … à trouver …par contre effectivement ca fait la même chose que application.trim et non trim de vba
une solution???
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
Cordialement
Ryu
La connaissance s’acquiert par l’expérience, tout le reste n’est que de l’information. – Albert Einstein
Pensez à la Balise [ CODE][/CODE ] - à utiliser via le bouton # => Exemple
Une fois votre problème solutionné pensez à mettre en n'oubliant pas d'indiquer qu'elle est la solution finale choisie
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.
Le savoir est le plus intellectuel des virus, dommage qu'il ne soit pas très contagieux.
Adrien Verschaere
Étudiant, France, 1997
Hi Patrick et le forum,
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 SubLes formules :
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
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
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
Merci d'avance à la personne qui me donnera cette formule si c'est possible
Cordialement
Ryu
La connaissance s’acquiert par l’expérience, tout le reste n’est que de l’information. – Albert Einstein
Pensez à la Balise [ CODE][/CODE ] - à utiliser via le bouton # => Exemple
Une fois votre problème solutionné pensez à mettre en n'oubliant pas d'indiquer qu'elle est la solution finale choisie
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
par contre si j'utilise la fonction en tant que return Rng ne plante pas
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
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
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
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
Cordialement
Ryu
La connaissance s’acquiert par l’expérience, tout le reste n’est que de l’information. – Albert Einstein
Pensez à la Balise [ CODE][/CODE ] - à utiliser via le bouton # => Exemple
Une fois votre problème solutionné pensez à mettre en n'oubliant pas d'indiquer qu'elle est la solution finale choisie
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)
la sub pour tester
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
fonctionne avec toute les fonction sur 2007 et 2013 32 bits
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
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
Sinon ça ne marche pas sur ta version 2007 ??en fait il faut l'utiliser comme un fonction est sensée fonctionner
a savoir en exploitant le Return dans la sub test
Cordialement
Ryu
La connaissance s’acquiert par l’expérience, tout le reste n’est que de l’information. – Albert Einstein
Pensez à la Balise [ CODE][/CODE ] - à utiliser via le bouton # => Exemple
Une fois votre problème solutionné pensez à mettre en n'oubliant pas d'indiquer qu'elle est la solution finale choisie
si la feuille n'est pas active non
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
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
Cordialement.
J'utilise toujours le point comme séparateur décimal dans mes tests.
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
Le savoir est le plus intellectuel des virus, dommage qu'il ne soit pas très contagieux.
Adrien Verschaere
Étudiant, France, 1997
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 faitje vais vérifier si je peux l'intégrer j'ai réduit le tout a une seule fonction
Code : Sélectionner tout - Visualiser dans une fenêtre à part Addr=rng.parent.codename &"!" & rng.address
le pauvre vba14 il doit avoir mal aux yeux
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
mercatog,
bien vu
pourquoi faire compliqué alors que l'on peut faire simple ...
Cordialement
Ryu
La connaissance s’acquiert par l’expérience, tout le reste n’est que de l’information. – Albert Einstein
Pensez à la Balise [ CODE][/CODE ] - à utiliser via le bouton # => Exemple
Une fois votre problème solutionné pensez à mettre en n'oubliant pas d'indiquer qu'elle est la solution finale choisie
re ca ne fonctionne pas Mercatog 2013 32
la fonction tout en un
la 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 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
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
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
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
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
Re,
Patrick :C'est quoi qui ne fonctionne pas ??re ca ne fonctionne pas Mercatog 2013 32
Cordialement
Ryu
La connaissance s’acquiert par l’expérience, tout le reste n’est que de l’information. – Albert Einstein
Pensez à la Balise [ CODE][/CODE ] - à utiliser via le bouton # => Exemple
Une fois votre problème solutionné pensez à mettre en n'oubliant pas d'indiquer qu'elle est la solution finale choisie
re
test ca en changeant l'argument
ce qui ne fonctionne plus
trim, apptrim ,rtrim
pour APPTRIM j'ai ajouter ca en debut de fonction prop = Replace(UCase(prop), "APPTRIM", "TRIM")
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
mais ca marche plus quand meme
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
Vous avez un bloqueur de publicités installé.
Le Club Developpez.com n'affiche que des publicités IT, discrètes et non intrusives.
Afin que nous puissions continuer à vous fournir gratuitement du contenu de qualité, merci de nous soutenir en désactivant votre bloqueur de publicités sur Developpez.com.
Partager