Enlever des retours chariots dans excell

Enlever des retours chariots dans excell - VB/VBA/VBS - Programmation

Marsh Posté le 16-09-2004 à 18:56:00    

Bijour,
j'ai besoin d'une macro pour virer des retours chariots dans des fichiers excel pour faire des publipostages propres.
J'ai commencé par çà Dim CPT As Integer
Dim STOC As String
Dim WORD As String
 
 
STOC = ActiveCell.Value
CPT = 1
WORD = ""
Do While CPT <= Len(STOC)
If Mid(STOC, CPT, 1) <> vbCrLf Then
WORD = WORD & Mid(STOC, CPT, 1)
CPT = CPT + 1
Else
WORD = WORD & ","
CPT = CPT + 1
End If
Loop
ActiveCell.Value = WORD
 
STOC représente le texte et CPT un compteur mais çà marche pas

Reply

Marsh Posté le 16-09-2004 à 18:56:00   

Reply

Marsh Posté le 16-09-2004 à 19:04:34    

En truc simple sinon j'ai çà qui marche en faisant juste une formule
Remplacer les retours chariot  
 
si les données sont dans la plage A1:A100, sélectionne B1, entre la formule =SUBSTITUE(A1;CAR(10);" " ),
puis recopie-la jusqu'à B100. Ensuite, fais un copier / collage spécial valeurs uniquement de B1:B100 vers A1:A100
 
Mais çà me les remplace et j'aimerai que çà vire que ceux ou y'a rien marqué après

Reply

Marsh Posté le 17-09-2004 à 01:10:37    

Salut,
 
Tu peux essayer ceci :
 
Dim CL As Range
For Each CL In Range("A1:A3" )
  CL = Replace(CL, Chr(10), " " )
Next
 
Il te suffit d'adapter le code en remplaçant "A1:A3" par la bonne plage.
 
A+
Horry

Reply

Marsh Posté le 17-09-2004 à 11:32:17    

Lord Nelson a écrit :

Salut,
 
Tu peux essayer ceci :
 
Dim CL As Range
For Each CL In Range("A1:A3" )
  CL = Replace(CL, Chr(10), " " )
Next
 
Il te suffit d'adapter le code en remplaçant "A1:A3" par la bonne plage.
 
A+
Horry


Mici je teste çà   :hello:

Reply

Marsh Posté le 17-09-2004 à 11:39:50    

Eux çà marche pas !!!!
Mince !!! pkoi...

Reply

Marsh Posté le 17-09-2004 à 12:23:07    

EUx CL C pas CR ?
Sinon je comprend pas bien ou tu limite le fait de supprimer le retour chariot si la ligne est vide.

Reply

Marsh Posté le 17-09-2004 à 14:14:08    

celle ci fonctionne mais supprime tout:
Bijour,
Voilà mon soucis,
je suis un noOb énorme.
J'ai un fichier excel de clients que je voudrai utiliser pour faire du publipostage.
Mon problème c'est qu'il y'a des retours chariots dans les celule excel. (ex 4 lignes pr l'adresse).
J'aimerai faire une macro qui supprimme les retours chariots qui sont vides après.
Actuellement j'arrive à faire çà  
Sub RemoveEnters()
      Cells.Replace What:=Chr(10), Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
End Sub
 
Mais çà me supprime tout les retours chariots.
J'ai celle-ci mais çà marche pas du tout:
Sub test()
 Dim CPT As Integer
Dim STOC As String
Dim WORD As String
 
 
STOC = ActiveCell.Value
CPT = 1
WORD = ""
Do While CPT <= Len(STOC)
If Mid(STOC, CPT, 1) <> Chr(10) Then
WORD = WORD & Mid(STOC, CPT, 1)
CPT = CPT + 1
Else
WORD = WORD & " "
CPT = CPT + 1
End If
Loop
ActiveCell.Value = WORD
End Sub
 

Reply

Marsh Posté le 17-09-2004 à 16:42:22    

Si tu parle de retour a la ligne (carriage return) alors c’est plutôt chr(13).  
 
 
Public Sub TestValidCHR()
 
'Clean the strings characters of carriage return
'----------------------
'Variables declarations
'----------------------
Dim srng As Range
Dim ZoneText, StrTmp, StrTmp2 As String
Dim Erreur As Boolean
'--------------
'Initialization
'--------------
T = 0
'Assigns the SRNG object reference to the beginning of the sheet
Set srng = ActiveWorkBook.Sheets(ShName).Range("a1" )
Do While T < 4000    
    For J = 1 To 4000
Erreur = False
             ZoneTexte = srng.Offset(T, J)
             For I = 1 To Len(ZoneTexte)
                    StrTmp = Mid(ZoneTexte, I, 1)
                    If StrTmp <> Chr(13) Then
                        StrTmp2 = StrTmp2 + StrTmp
                    Else
                        Erreur = True
                        If Right(StrTmp2, 1) <> " " Then StrTmp2 = StrTmp2 + " "
                    End If
                Next I
                If Erreur Then srng.Offset(T, J) = ZoneTexte
            Next J    
       T = T + 1
Loop
Essaie ca man,  si ca marche pas alors DEBUG le

Reply

Marsh Posté le 17-09-2004 à 16:44:11    

arthropode a écrit :

Si tu parle de retour a la ligne (carriage return) alors c’est plutôt chr(13).  :??:  
 
 
Public Sub TestValidCHR()
 
'Clean the strings characters of carriage return
'----------------------
'Variables declarations
'----------------------
Dim srng As Range
Dim ZoneText, StrTmp, StrTmp2 As String
Dim Erreur As Boolean
'--------------
'Initialization
'--------------
T = 0
'Assigns the SRNG object reference to the beginning of the sheet
Set srng = ActiveWorkBook.Sheets(ShName).Range("a1" )
Do While T < 4000    
    For J = 1 To 4000
Erreur = False
             ZoneTexte = srng.Offset(T, J)
             For I = 1 To Len(ZoneTexte)
                    StrTmp = Mid(ZoneTexte, I, 1)
                    If StrTmp <> Chr(13) Then
                        StrTmp2 = StrTmp2 + StrTmp
                    Else
                        Erreur = True
                        If Right(StrTmp2, 1) <> " " Then StrTmp2 = StrTmp2 + " "
                    End If
                Next I
                If Erreur Then srng.Offset(T, J) = ZoneTexte
            Next J    
       T = T + 1
Loop
Essaie ca man,  si ca marche pas alors DEBUG le  :sol:  

Reply

Marsh Posté le 18-09-2004 à 00:03:50    

arthropode a écrit :

Si tu parle de retour a la ligne (carriage return) alors c’est plutôt chr(13).  
 
 
Public Sub TestValidCHR()
 
'Clean the strings characters of carriage return
'----------------------
'Variables declarations
'----------------------
Dim srng As Range
Dim ZoneText, StrTmp, StrTmp2 As String
Dim Erreur As Boolean
'--------------
'Initialization
'--------------
T = 0
'Assigns the SRNG object reference to the beginning of the sheet
Set srng = ActiveWorkBook.Sheets(ShName).Range("a1" )
Do While T < 4000    
    For J = 1 To 4000
Erreur = False
             ZoneTexte = srng.Offset(T, J)
             For I = 1 To Len(ZoneTexte)
                    StrTmp = Mid(ZoneTexte, I, 1)
                    If StrTmp <> Chr(13) Then
                        StrTmp2 = StrTmp2 + StrTmp
                    Else
                        Erreur = True
                        If Right(StrTmp2, 1) <> " " Then StrTmp2 = StrTmp2 + " "
                    End If
                Next I
                If Erreur Then srng.Offset(T, J) = ZoneTexte
            Next J    
       T = T + 1
Loop
Essaie ca man,  si ca marche pas alors DEBUG le


merci  :jap:  je teste çà

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed