Bonjour,
Le code déposé initialement était ma première contribution sur ce site et je ne l'avais pas rendu indépendant de toutes procédures comme j'en ai l'habitude. C'est maintenant chose faite.
Voici donc ce code placé dans une procédure (fonction) nommée TrimTable qui supprime tous les espaces d'une chaîne de caractères à l'exception des espaces entre les mots et qui renvoie un objet range qui correspond à la plage ou aux plages traitées avec passage de deux arguments dont un est obligatoire.
La sélection de cellules non contiguës est autorisée, je l'ai cependant limitée à 255 sélections.
Les arguments
Obligatoire
ShtRng : de type Objet peut-être un objet WorkSheet ou un objet Range. Si l'objet est une feuille, la plage doit commencer en A1.
Optionnel
ValueOnly : FALSE (défaut) copie les formules, TRUE si on veut avoir uniquement les valeurs.
La syntaxe
La procédure peut être invoquée comme une fonction ou comme procédure SUB
Quelques exemples :
Avec l'argument ShtRng comme Objet feuille (ici l'argument ValueOnly est omis donc False par défaut.
TrimTable ThisWorkbook.Worksheets("Test_")
ou invoqué comme fonction avec l'argument ValueOnly à True
MsgBox TrimTable(ThisWorkbook.Worksheets("Test_"), True).Address
Avec l'argument ShtRng comme Objet Range.
TrimTable ThisWorkbook.Worksheets("Test_").Range("B2:H5")
ou encore
TrimTable(ThisWorkbook.Worksheets("Test_").Range("B2:H5")).Interior.Color = vbYellow
Avec cellules non contigües
TrimTable ThisWorkbook.Worksheets("Test_").Range("$A$6:$A$9,$C$11:$C$13,$D$6:$D$7,$C$6,$D$15")
Avec les cellules sélectionnées
La procédure
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
| Function TrimTable(ShtRng As Object, Optional ValueOnly As Boolean = False) As Range
' Supprime tous les espaces d'une chaîne de caractères à l'exception des espaces entre les mots
' Renvoie un objet Range
' Author : Philippe Tulliez
' Date : 19/01/2013 (17/01/2013)
' Version 2.3
' Arguments
' ShtRng - Object (WorkSheet ou Range)
' [ValueOnly] - Boolean si True transforme le résultat des formules en constante [d=False]
' Maximum 255 sélections de cellules non-contguës
Const ErrTitle As String = "Procédure - TrimTable":
Dim ErrMsg As String: ErrMsg = "*** Sortie de procédure ***" & vbCrLf & vbCrLf
Dim myTable() As Variant, wRow As Double, wColumn As Double
Dim area As Byte, Rng As Range, myRange As Range
Select Case True ' Test 1er argument
Case ShtRng Is Nothing ' 19/01/13
MsgBox ErrMsg & "Problème argument (ShtRng Non affecté)", vbCritical, ErrTitle
Set TrimTable = ActiveCell
Exit Function ' Sortie de procédure
Case TypeOf ShtRng Is Worksheet: Set Rng = ShtRng.Range("A1").CurrentRegion
Case TypeOf ShtRng Is Range: Set Rng = ShtRng
Case Else
ErrMsg = ErrMsg & "Problème argument - ShtRng " & vbCrLf
MsgBox ErrMsg & "* Objet mal défini (WorkSheet) ou (Range)", vbCritical, ErrTitle
Set TrimTable = ActiveCell
Exit Function ' Sortie de procédure
End Select
For area = 1 To Rng.Areas.Count
Set myRange = Rng.Areas(area)
'
Select Case myRange.Count
Case 1 ' Une cellule
If ValueOnly Then myRange = Trim(myRange.Value) Else myRange = Trim(myRange.Formula)
Case Else
If ValueOnly Then myTable() = myRange.Value Else myTable() = myRange.Formula
For wRow = 1 To UBound(myTable, 1)
For wColumn = 1 To UBound(myTable, 2)
On Error Resume Next ' Si erreur renvoyée par une formule (ex #N/A)
myTable(wRow, wColumn) = Trim(myTable(wRow, wColumn))
On Error GoTo 0
Next wColumn
Next wRow
myRange = myTable()
End Select
Next area
Set TrimTable = Rng: Set Rng = Nothing: Set myRange = Nothing
End Function |
Malgré le soin apporté à la programmation de cette procédure et au multiples tests réalisés, il est possible qu'il subsiste une erreur qui m'aurait échappé. N'hésitez pas à m'en faire part.
[EDIT]
J'ai déposé une nouvelle version avec un test ShtRng Is Nothing (merci à NVCfrm de l'avoir signalé)
Code pour éliminer les espaces (TRIM) dans un tableau
et si celle-ci est pertinente pensez à voter 
Répondre avec citation
Envoyé par NVCfrm
Partager