Supprimer les espaces !!

[Jetlager]

Bonjour

voilà mon cas

j'ai trois colonnes A, B, et C
les données qui m'ont été rapatriées ne sont pas homogènes et comportent pour la plupart des espaces avant ou après la données dans les cellules.

J'aurai voulu faire un traitement de suppression de espaces par la fonction adéquate mais écrire tout ça dans une procédure. En fait ce fichier excell me revient chaque semaine.

Y'a t-il y moyen plus simple que de traiter les colonnes les unes après les autres ?


Est-ce qu'on peut traiter les 3 colonnes en meme temps ou alors sommes nous obligés de traiter colonnes par colonnes ?

Un simple avis de votre part me serais d'un grand soutien car si je fais une macro compliquée alors qu'il existerait un moyen plus simple ça me ferait mal quand meme !!!!

Merci d'avoir lu mon post

 

[Flyonets]

bonjour
ce code macro pour te depanner
Sub Clean_espace() '10-09-05
' Suppression des espaces dans des colonnes
Application.ScreenUpdating = False
Dim Vlign&, Vcol&, Derli&, Tblo,Y&,Z&
Tblo = Array(3, 5) 'Les colonnes à traiter
'Vcol =Colonne active , vlign =Ligne active, Derli dernière ligne de la plage
For Y = 1 To UBound(Tblo)
Vcol = Tblo(Y): Vlign = 1
Derli = Cells(65536, Vcol).End(xlUp).Row
With ActiveSheet
Tablo = ActiveSheet.Cells(Vlign, Vcol).Resize(Derli, Vcol).Value
For Z = LBound(Tablo, 1) To UBound(Tablo, 1)
Tablo(Z, 1) = Trim(Tablo(Z, 1))
Next
'Retour du tableau nouveau dans la feuille
ActiveSheet.Cells(Vlign, Vcol).Resize(Derli, Vcol) = Tablo
End With
Next
Erase Tablo
End Sub
Bonne journée

 

[Staple1600]

Bonjour

De tête et sans avoir tester

Sub NOSPACES()
Dim c As Range
For Each c In ActiveSheet.UsedRange
c.value=Application.Trim(c.value)
Next
End Sub

 

[Jetlager]

Un grand merci à tous les deux
je n'attendais pas une réponse aussi rapide, mais ............ je l'espèrais.

Vais essayer ça dès ce matin !!!!

Peut-être une fin de semaine bien meilleure que le début
et un bon we en perspective.

Je vous en souhaite autant.

@ bientôt

 

[Staple1600]

Donc j'ai testé
ca fonctionne

Une petite amélioration

Sub NOSPACES()
Dim c As Range
Application.ScreenUpdating = False
For Each c In ActiveSheet.UsedRange
c.value=Application.Trim(c.value)
Next
End Sub

Reste le cas des cellules contenant des formules
car cette macro les formules sont remplacées par leurs valeurs

ce qui est fort ennuyeux

Donc je reviendrais
Voila je suis revenu

Sub NOSPACESKEEPF()
Dim c As Range
Application.ScreenUpdating = False
For Each c In ActiveSheet.UsedRange
If c.HasFormula = True Then Exit Sub
c.Value = Application.Trim(c.Value)
Next
End Sub

Message édité par: staple1600, à: 23/09/2005 15:44

 

[Hervé]

bonjour tout le monde

Staple, pour les formules, tu peux essayer ceci :

If Not c.HasFormula Then c.Value = Application.Trim(c.Value)


salut

 

[Staple1600]

On a eu la même idée

Merci Hervé


J'étais parti sur
If Not Left(c,1)='=' Then

Ce qui ne fonctionne pas (normal)

puis j'ai oublié mon Not dans HasFormula

 

[Jetlager]

Merci de poursuivre ce sujet

Voilà : mon résultat :

avec le code de Flyonets, je n'ai pas obtenu quelque chose de probant.
En fait c'est comme si ce code était inactivé, et je suis donc passé au suivant.

Staple1600 j'ai mis ton code en test, et là aucun problème, l'effet magique quoi.
Il faut répéter l'opération sur chaque onglet, mais je pense m'en sortir à ce niveau. ET LE RESULTAT ME CONVIENT TOUT A FAIT.

Malheureusement le rêve n'est pas allé plus loin, car j'ai peut-être omis quelques précisions de mon premier post.
Je m'explique.

Ton code Staple1600 fonctionne à merveille si je le recopie dans une macro dans le perso Excel.
Mais mon application tourne sous access alors les procédures sont hébergées à ce niveau dans vb. Elles sont lancées au moyen des bouton correspondant, figurant dans un menu.

- Fenetre pour cibler le fichier xls à traiter
- Quelques lignes d'instructions qui vont opérer une mise à jour sur tous les onglets.
- Histoire d'obtenir au final des champs contenant des données homogène et intègre, qui seront importées dans une table acces.

Ce fichier excel m'est transmis hebdomadairement et ne contient pas de formule. Ce qui au passage pourra simplifier la tâche.

Au résultat :

ta première proposition
Dim c As Range
For Each c In ActiveSheet.UsedRange
c.value=Application.Trim(c.value)
Next

il m'est indiqué une erreur de compilation:
Membre de méthode ou de données introuvable
et l'extrait suivant est surligne : .Trim

J'ai donc essayé ce matin ta nouvelle méthode

Le résultat est un peu différent :

c'es .ScreenUpdating = qui est surligné.

Je ne suis donc pas allé plus.
Il y a peut-être un problème de conversion ou de paramètrage de VB afin qu'il puisse exécuter ton code.

Je ne sais pas si tu as une petite idée.

Evidemment si tu veux je peux d'envoyer un extrait du code je le mets dans le prochain post.

 

[Jetlager]

Afin de ne pas me mélanger dans un seul post je mets ici une copie de ma procédure de traitement de mon fichier source.

J'ai placé ton code vers le bas



Private Sub TRAITEMENT_FICHIER_SOURCE_Click()
Dim MonFichier As String, i As Integer
Dim xlApp As Object
Dim MonWk As Object
Dim MaFeuil As Object
Dim plage(50) As String, nbf As Integer

'supprime les enregistrements déjà présents de la table SCORPENE>>>>>>>>>>>>>>>>>>>>>>>>>>>
CodeDb.Execute 'delete * from SCORPENE'

MonFichier = OuvrirUnFichier(hWndAccessApp, 'Ouvrir', 1, 'Microsoft Excel', 'xls', CurrentProject.Path) 'ouvre le fichier
If MonFichier = '' Then Exit Sub
'sortie si pas de sélection de fichier

'création de l'objet Excel>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Set MonExcel = CreateObject('excel.application')
MonExcel.Visible = False
'force à invisible

'ouvre le fichier>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Set MonWk = MonExcel.Workbooks.Open(MonFichier)
nbf = MonWk.Sheets.Count
'sauve le nombre de feuilles présentes
For i = 1 To Worksheets.Count
Worksheets(i).Activate

' suppression des filtres>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Selection.AutoFilter

' libération des volets>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
ActiveWindow.FreezePanes = False

' suppression des 3 premières lignes>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Rows('1:3').Select
Selection.Delete Shift:=xlUp

' insertion 3 colonnes en A B et C pour y placer les données>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Columns('A:A').Select
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight

Next

' Insertion colonne repere nature sur l'onglet tuyau>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Sheets('Tuyau').Select
Columns('E:E').Select
Selection.Insert Shift:=xlToRight
Range('E1').Select
ActiveCell.FormulaR1C1 = 'Repere Nature'
With ActiveCell.Characters(Start:=1, Length:=13).Font
.Name = 'Arial'
.FontStyle = 'Gras'
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 11
End With

' Insertion colonne Designation sur l'onglet Câble>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Sheets('Câble').Select
Columns('E:E').Select
Selection.Insert Shift:=xlToRight
Range('E1').Select
ActiveCell.FormulaR1C1 = 'Designation'
With ActiveCell.Characters(Start:=1, Length:=13).Font
.Name = 'Arial'
.FontStyle = 'Gras'
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 11
End With

Sheets('Chaîne de mesure').Select
Range('A1').Select



nbf = MonWk.Sheets.Count
'sauve le nombre de feuilles présentes
For i = 1 To Worksheets.Count
Worksheets(i).Activate

' insertion 3 colonnes en A B et C pour y placer les données>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Columns('A:A').Select
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight

'recherche champ Repere, champ à rapatrier dans la colonne A>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Cells.Find(What:='Repere', After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
Range(Selection, Selection.End(xlDown)).Select

Selection.Cut
Range('A1').Select
ActiveSheet.Paste

' recherche champ Designation, champ à rapatrier dans la colonne B>>>>>>>>>>>>>>>>>>>>>>>>>

Cells.Find(What:='Designation', After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
Range(Selection, Selection.End(xlDown)).Select

Selection.Cut
Range('B1').Select
ActiveSheet.Paste

' recherche champ Repere Nature, champ à rapatrier dans la colonne >>>>>>>>>>>>>>>>>>>>>>>>

Cells.Find(What:='Nature', After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
Range(Selection, Selection.End(xlDown)).Select

Selection.Cut
Range('C1').Select
ActiveSheet.Paste

' suppression des espaces dans les cellules

Dim c As Range
Application.ScreenUpdating = False
For Each c In ActiveSheet.UsedRange
c.Value = Application.Trim(c.Value)
Next


' positionnement cellule active en A1 et dimensionnement des colonnes traitées>>>>>>>>>>>>>

Columns('A:C').Select
Columns('A:C').EntireColumn.AutoFit
Range('A1').Select

Next

Worksheets(1).Activate

' Sauvegarde et quitte le fichier xls>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

ActiveWorkbook.Save
MonExcel.Quit
Set objXL = Nothing


MsgBox 'Fin de la procédure.'
End Sub

 

[Jetlager]

En fait: ça marche ....... dans une macro excell

Seulement je suis un gros nul et je me bats depuis ce matin pour ajuster les paramètres dans le module VB de access.

En fait j'ai un début de procédure qui déclare certaines variables et je ne sais pas adapter le nouveau code à mon début de procédure (forcément c'est quelqu'un d'autre qui m'a fortement aidé à le créer)
mais chut ..... ne le répétez pas !!!!


Je donne donc le début de procédure, ce qui semble peut etre mieux correspondre au besoin.

Private Sub TRAITEMENT_FICHIER_SOURCE_Click()

Dim MonFichier As String, i As Integer
Dim xlApp As Object
Dim MonWk As Object
Dim MaFeuil As Object
Dim Plage(50) As String, nbf As Integer


'supprime les enregistrements déjà présents de la table SCORPENE>>>>>>>>>>>>>>>>>>>>>>>>>>>
CodeDb.Execute 'delete * from SCORPENE'

MonFichier = OuvrirUnFichier(hWndAccessApp, 'Ouvrir', 1, 'Microsoft Excel', 'xls', CurrentProject.Path)
'ouvre le fichier
If MonFichier = '' Then Exit Sub
'sortie si pas de sélection de fichier

'création de l'objet Excel>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Set MonExcel = CreateObject('excel.application')
MonExcel.Visible = False
'force à invisible

'ouvre le fichier>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Set MonWk = MonExcel.Workbooks.Open(MonFichier)
nbf = MonWk.Sheets.Count
'sauve le nombre de feuilles présentes
For i = 1 To Worksheets.Count
Worksheets(i).Activate

' suppression des filtres>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Selection.AutoFilter

' libération des volets>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
ActiveWindow.FreezePanes = False

' suppression des 3 premières lignes>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Rows('1:3').Select
Selection.Delete Shift:=xlUp


'suppresstion des espaces dans les cellules

Dim c As Range
For Each c In ActiveSheet.UsedRange
c.Value = Application.Trim(c.Value)

 

[Marc_du_78]

Bonsoir à tous,

Je 'tombe' par hasard sur ce fil et j'en profite pour joindre une macro du 'panier' de papynovice
Je présente mes excuses si je n'aurai pas du le faire, car je n'ai aucune référence de l'auteur ni de lien.
En souhaitant seulement me rendre utile, je vous souhaite une bonne soirée [file name=MenageExcel.zip size=33982]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/MenageExcel.zip[/file]