Effacer espace dans les blanks

teodormircea

XLDnaute Occasionnel
Re sal le forum
J'ai fait une macros qui détecte et efface tout les espaces des cellules dans les blancs.
Code:
Sub Blancs()
    
       
       Dim X As Integer
       Dim r As Range
       X = CLng(InputBox(Prompt:="Quelle colonne?"))
       If (X < 1) + (X > Columns.Count) Then Exit Sub
       lastRow = ActiveSheet.Cells(Rows.Count, X).End(xlUp).Row
       For Each r In Range(Cells(1, X), Cells(Rows.Count, X).End(xlUp))
       If r.Value = "" Then
       r.ClearContents
       End If
    Next
    
End Sub
Le truc c'est que c'est tres lent,il y a t'il une méthode pour faire çà plus vite, ou améliorer mon truc
 

zouhenlai

XLDnaute Nouveau
Re : Effacer espace dans les blanks

tiens qu'en penses-tu ?

sur les 10 premières lignes et les 10 premières collones :

Code:
Sub Macro3()

Dim x As Integer
Dim y As Integer

For x = 1 To 10
For y = 1 To 10
    Range("R" & x, "C" & y).Select
    Cells.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:= _
        xlByRows, MatchCase:=False
Next
Next

End Sub
 

teodormircea

XLDnaute Occasionnel
Re : Effacer espace dans les blanks

Un blank peux avoir des espaces dedans et c'est compte comme un caractere
tu peut effacer les espaces des blank en filtrant sur des blanks les selectionner et puis delete.
imaginez 30 colonnes et que je veux compter les donnes dans 10 seulement, ca vas etre la galere de faire des filtres et ansi de suite
une macros peut faire ca facilement, sur une colonne ou toute la feuille.
la solution je l'ai mais pas rapide
 

skoobi

XLDnaute Barbatruc
Re : Effacer espace dans les blanks

Bonsoir le fil,

Un blank peux avoir des espaces dedans et c'est compte comme un caractere
tu peut effacer les espaces des blank en filtrant sur des blanks les selectionner et puis delete.
Euuhh non, un "blank" comme tu dis est une cellule vide,
r.Value = "" dans ton cas.

Si la cellule contient des espaces, et bien la cellule fera r.Value = " " par exemple, donc ceci:

If r.Value = "" Then
r.ClearContents
End If

ne dois pas faire ce que tu souhaite, d'où la question de JM.
 

Staple1600

XLDnaute Barbatruc
Re : Effacer espace dans les blanks

Re

EDIT: Pourquoi n'avoir pas continuer dans ce premier fil?
https://www.excel-downloads.com/threads/effacer-caracteres.94982/


Pour sélectionner les cellules vides
Code:
[B]ActiveSheet.UsedRange.SpecialCells(xlCellTypeBlanks).Select
[/B]
De plus une cellule contenant un espace ou tout autre caractère du style
(Chr(32), Chr(160) etc) n'est donc plus une cellule vide.
 
Dernière édition:

teodormircea

XLDnaute Occasionnel
Re : Effacer espace dans les blanks

Voila une soulution qui marche par colonne:
Sub SpacesBlanksI()
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False

Dim X As Integer
Dim r As Range
X = CLng(InputBox(Prompt:="Quelle colonne?"))
If (X < 1) + (X > Columns.Count) Then Exit Sub
lastRow = ActiveSheet.Cells(Rows.Count, X).End(xlUp).Row
For Each r In Range(Cells(1, X), Cells(Rows.Count, X).End(xlUp))
If r.Value = "" Then
r.Value = ClearContents
End If
Next

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True

End With
End Sub

Mais je suis en train de la modifier pour que ca marche pour une range et
ca me donne des erreurs.>> sur la ligne:If r.Value = "" Then type mismatch
 

Staple1600

XLDnaute Barbatruc
Re : Effacer espace dans les blanks

Re



Je ne comprends absolument pas ton raisonnement

Une cellule qui contient un espace ou un caractère non imprimable
n'est pas vide non?
Si A1 contient un espace
Si tu fais =NBCAR(A1)
cela renvoie 1

C'est donc une cellule non vide

Ta macro , elle efface le contenu des cellules vides.
If r.Value = "" Then
r.Value = ClearContents

Ce qui est un non sens !!!

Alors que pour faire cela (???????)
Il suffit de:
ActiveSheet.UsedRange.SpecialCells(xlCellTypeBlanks).ClearContents

Ce qui est également un non sens!
 

Staple1600

XLDnaute Barbatruc
Re : Effacer espace dans les blanks

Re


En guise de conclusion
(pour ce qui me concerne)

Code:
Function ReplaceClean(sText As String, Optional sSubText As String = " ")
  'auteur : Allen WYATT
    Dim J As Integer
    Dim vAddText

    vAddText = Array(Chr(32), Chr(129), Chr(141), Chr(143), Chr(144), Chr(157), Chr(160))
    For J = 1 To 31
        sText = Replace(sText, Chr(J), sSubText)
    Next
    For J = 0 To UBound(vAddText)
        sText = Replace(sText, vAddText(J), sSubText)
    Next
    ReplaceClean = sText
End Function
Sub test()
Application.ScreenUpdating = False
Dim cell As Range
For Each cell In ActiveSheet.UsedRange
cell.Value = ReplaceClean(cell.Value, "")
Next cell
Application.ScreenUpdating = True
End Sub
 

Discussions similaires

Réponses
17
Affichages
803

Membres actuellement en ligne

Statistiques des forums

Discussions
312 084
Messages
2 085 194
Membres
102 812
dernier inscrit
abdouami