Comment supprimer les espaces doubles ou triples à l'intérieur d'un texte ?
[A1] = [trim(A1)]
il est à noter que les fonctions TRIM
ont des résultats differents selon VBA ou EXCEL
la fonction de feuille de calcul =SUPPRESPACE (=TRIM en langage US)
se comporte differement de la fonction VBA TRIM,
seule la fonction de feuille de calcul supprime les espaces interieurs
ce qu'a parfaitement résumé AV par la formule ci dessus
pour s'en convaincre :
Sub Supprimer_les_espaces_en_trop()
texteorigine = "Voici un texte avec des tas d'espaces en trop "
[A1] = texteorigine
[B1].FormulaLocal = "=NBCAR(A1)"
[A2].Formula = "=TRIM(A1)" ' --------fonction feuille de calcul
[B2].FormulaLocal = "=NBCAR(A2)"
[A3] = Trim(texteorigine) ' ---------fonction VBA
[B3].FormulaLocal = "=NBCAR(A3)"
[A4]= [TRIM(A1)] ' ------réponse de AV
Range("A1:A4").Font.Name = "Courier new"
End Sub
il est à noter que les fonctions TRIM
ont des résultats differents selon VBA ou EXCEL
la fonction de feuille de calcul =SUPPRESPACE (=TRIM en langage US)
se comporte differement de la fonction VBA TRIM,
seule la fonction de feuille de calcul supprime les espaces interieurs
ce qu'a parfaitement résumé AV par la formule ci dessus
pour s'en convaincre :
Sub Supprimer_les_espaces_en_trop()
texteorigine = "Voici un texte avec des tas d'espaces en trop "
[A1] = texteorigine
[B1].FormulaLocal = "=NBCAR(A1)"
[A2].Formula = "=TRIM(A1)" ' --------fonction feuille de calcul
[B2].FormulaLocal = "=NBCAR(A2)"
[A3] = Trim(texteorigine) ' ---------fonction VBA
[B3].FormulaLocal = "=NBCAR(A3)"
[A4]= [TRIM(A1)] ' ------réponse de AV
Range("A1:A4").Font.Name = "Courier new"
End Sub
Alain Vallon, GeeDee,
Ajouté ou modifié le 29/10/2004 (N°1511)
Ajouté ou modifié le 29/10/2004 (N°1511)
J'ai besoin d'enlever tous les accents d'un texte...
Tu peux utiliser l'une ou l'autre de ces fonctions.
Il faut ouvrir VBA, insérer un nouveau module, ne surtout pas mettre la fonction dans le
code d'une page.
Tu colles la fonction. Dans ta feuille il te suffit alors de taper par ex en G2
=Virer_Accents(F2)
et si ton texte en F2 contient des accents il se retrouve sans dans G2.
Function Virer_Accents$(Chaine$)
Dim tmp$
tmp = Trim(Chaine)
For i = 1 To Len(tmp)
x = Asc(Mid(tmp, i, 1))
Select Case x
Case 192 To 197: x = "A"
Case 200 To 203: x = "E"
Case 204 To 207: x = "I"
Case 209: x = "N"
Case 210 To 214: x = "O"
Case 217 To 220: x = "U"
Case 221: x = "Y"
Case 224 To 229: x = "a"
Case 232 To 235: x = "e"
Case 236 To 239: x = "i"
Case 241: x = "n"
Case 240, 242 To 246: x = "o"
Case 249 To 252: x = "u"
Case 253, 255: x = "y"
Case Else: x = Chr(x)
End Select
Virer_Accents = Virer_Accents & x
Next
End Function 'AV
*******************************************************
2° possibilité :
Function Sans_accents$(Chaine$) ' R. Dezan + Michel Pierron
Cette fonction enlève également les Œ, œ, Æ, æ qui posent un problème sur les sytèmes anglais.
' remplacement des caractères accentués
a$ = "ÀÁÂÃÄÅÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåèéêëìíîïðñòóôõöùúûüýÿ"
b$ = "AAAAAAEEEEIIIINOOOOOUUUUYaaaaaaeeeeiiiionooooouuuuyy"
Chaine = Replace(Replace(Replace(Replace(Chaine, "œ", "oe"), "Œ",
"OE"), "æ", "ae"), "Æ", "AE")
For i% = 1 To Len(Chaine)
u% = InStr(1, a, Mid(Chaine, i, 1), 0)
If u Then Mid(Chaine, i, 1) = Mid(b, u, 1)
Next i
Sans_accents = Chaine
End Function
tu peux tester cette fonction à l'aide de la macro ci-dessous
Sub Test()
MsgBox Sans_accents("ÀÁÂÃÄÅÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåèéêëìíîïðñòóôõöùúûüýÿ")
MsgBox Sans_accents("0ZnÁrÄPË43ÑertÔÙdwxÛâçérðpõûÿ")
End Sub
*********************************************************
3° possiblité avec les API windows et de loin la plus rapide
Mais attention,elle ne fonctionne qu'avec windows NT, 2000 ou XP (pas 98 ou me)
et n'enlève pas les Œ, œ, Æ, æ et autres caratères très particuliers.
Private Declare Function FoldString Lib "kernel32" Alias "FoldStringA" _
(ByVal dwMapFlags As Byte, ByVal lpSrcStr As Long, ByVal cchSrc As Long, _
ByVal lpDestStr As Long, ByVal cchdest As Long) As Long
Function SANSACCENTS(Texte As String) As String
Dim I As Integer
SANSACCENTS = Space(Len(Texte))
For I = 0 To Len(Texte) * 2 - 2 Step 2
FoldString &H40, StrPtr(Texte) + I, 1, StrPtr(SANSACCENTS) + I, 1
Next I
End Function
Il faut ouvrir VBA, insérer un nouveau module, ne surtout pas mettre la fonction dans le
code d'une page.
Tu colles la fonction. Dans ta feuille il te suffit alors de taper par ex en G2
=Virer_Accents(F2)
et si ton texte en F2 contient des accents il se retrouve sans dans G2.
Function Virer_Accents$(Chaine$)
Dim tmp$
tmp = Trim(Chaine)
For i = 1 To Len(tmp)
x = Asc(Mid(tmp, i, 1))
Select Case x
Case 192 To 197: x = "A"
Case 200 To 203: x = "E"
Case 204 To 207: x = "I"
Case 209: x = "N"
Case 210 To 214: x = "O"
Case 217 To 220: x = "U"
Case 221: x = "Y"
Case 224 To 229: x = "a"
Case 232 To 235: x = "e"
Case 236 To 239: x = "i"
Case 241: x = "n"
Case 240, 242 To 246: x = "o"
Case 249 To 252: x = "u"
Case 253, 255: x = "y"
Case Else: x = Chr(x)
End Select
Virer_Accents = Virer_Accents & x
Next
End Function 'AV
*******************************************************
2° possibilité :
Function Sans_accents$(Chaine$) ' R. Dezan + Michel Pierron
Cette fonction enlève également les Œ, œ, Æ, æ qui posent un problème sur les sytèmes anglais.
' remplacement des caractères accentués
a$ = "ÀÁÂÃÄÅÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåèéêëìíîïðñòóôõöùúûüýÿ"
b$ = "AAAAAAEEEEIIIINOOOOOUUUUYaaaaaaeeeeiiiionooooouuuuyy"
Chaine = Replace(Replace(Replace(Replace(Chaine, "œ", "oe"), "Œ",
"OE"), "æ", "ae"), "Æ", "AE")
For i% = 1 To Len(Chaine)
u% = InStr(1, a, Mid(Chaine, i, 1), 0)
If u Then Mid(Chaine, i, 1) = Mid(b, u, 1)
Next i
Sans_accents = Chaine
End Function
tu peux tester cette fonction à l'aide de la macro ci-dessous
Sub Test()
MsgBox Sans_accents("ÀÁÂÃÄÅÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåèéêëìíîïðñòóôõöùúûüýÿ")
MsgBox Sans_accents("0ZnÁrÄPË43ÑertÔÙdwxÛâçérðpõûÿ")
End Sub
*********************************************************
3° possiblité avec les API windows et de loin la plus rapide
Mais attention,elle ne fonctionne qu'avec windows NT, 2000 ou XP (pas 98 ou me)
et n'enlève pas les Œ, œ, Æ, æ et autres caratères très particuliers.
Private Declare Function FoldString Lib "kernel32" Alias "FoldStringA" _
(ByVal dwMapFlags As Byte, ByVal lpSrcStr As Long, ByVal cchSrc As Long, _
ByVal lpDestStr As Long, ByVal cchdest As Long) As Long
Function SANSACCENTS(Texte As String) As String
Dim I As Integer
SANSACCENTS = Space(Len(Texte))
For I = 0 To Len(Texte) * 2 - 2 Step 2
FoldString &H40, StrPtr(Texte) + I, 1, StrPtr(SANSACCENTS) + I, 1
Next I
End Function
Alain Vallon, Robert Dezan, Michel Pierron, Laurent Longre,
Ajouté ou modifié le 20/02/2005 (N°818)
Ajouté ou modifié le 20/02/2005 (N°818)
J'ai reçu un fichier dont une colonne au format "Texte" contient une liste de nombre.
Lors du passage au format "Nombre" de la colonne, certaines cellules ne sont pas
affectées directement par cette modification. (La valeur reste à gauche). Je suis obligé de
rentrer dans la cellule (Double_click) et de valider. D'où cela peut-il provenir??
Si ta colonne texte est A:
après le passage au format nombre,
dans une colonne vide (par ex col B) tu utilise la fonction =CNUM(A1)
pour convertir ton texte en nombre, tu copies cette colonne et tu fais un
collage spécial valeur dans la colonne A. et tu effaces la colonne B.
après le passage au format nombre,
dans une colonne vide (par ex col B) tu utilise la fonction =CNUM(A1)
pour convertir ton texte en nombre, tu copies cette colonne et tu fais un
collage spécial valeur dans la colonne A. et tu effaces la colonne B.
Denis Pasquier, (N°817)
Comment faire pour mettre dans une cellule une partie seulement du texte en gras
Sans VBA, c'est enfantin, tu le sélectionnes et tu cliques sur l'icone "gras".
Par VBA, tu peux utiliser la position de la sous chaine pour le faire :
Sub MettreEnGras()
Range("A1") = "Automobile"
'Mettre en gras "bile"
Range("A1").Characters(7, 4).Font.Bold = True
End Sub
Par VBA, tu peux utiliser la position de la sous chaine pour le faire :
Sub MettreEnGras()
Range("A1") = "Automobile"
'Mettre en gras "bile"
Range("A1").Characters(7, 4).Font.Bold = True
End Sub
Denis Michon, (N°816)