fonction "replace" et chaine de caractère

Version imprimable

Bonjour,

Je voudrais savoir s'il est possible dans la macro ci-dessous d'ajouter une ligne qui supprimerais ou remplacerais par "" une chaine de caractere de type jj/mm/aaaa 12345.

Merci de votre a oui je debut en VBA.

bonne journée.

Code:

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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
Sub retourchariot()
 
Dim old_text As String
Dim new_text As String
 
ActiveCell.SpecialCells(xlLastCell).Select
DerCell = ActiveCell.Address
Range("b6:b6").Select
 
For Each Cellule In Range("b6:b6")
If Cellule.Value <> "" Then
old_text = Cellule.Value
new_text = Replace(old_text, Chr(10), " ") 'élimine les sauts de ligne
new_text = Replace(new_text, Chr(13), " ") 'élimine les retours a la ligne
new_text = Replace(new_text, Chr(34), " ") 'élimine les guillemets
'new_text = Replace(new_text, Chr(44), " ") 'élimine les virgules
'new_text = Replace(new_text, Chr(59), " ") 'élimine les points virgules
new_text = Replace(new_text, "Message Text:", "Mess:")
new_text = Replace(new_text, "Severity:  Critical Node:", "")
new_text = Replace(new_text, "alerte hpov w2k", "")
new_text = Replace(new_text, "  . ", "")
new_text = Replace(new_text, "Application:", "Appli:")
new_text = Replace(new_text, "de l'application", "l'appli")
new_text = Replace(new_text, "alerte controlm", "Ctrlm")
new_text = Replace(new_text, "Alerte controlm", "Ctrlm")
new_text = Replace(new_text, " (*) NS3", "")
new_text = Replace(new_text, " (*) NS4", "")
new_text = Replace(new_text, "State: Active Service:", "")
new_text = Replace(new_text, "Destinataire", "Dest")
new_text = Replace(new_text, "Node", "")
new_text = Replace(new_text, "Transfert", "Trans")
new_text = Replace(new_text, " Owner", "")
new_text = Replace(new_text, "numéro", "n°")
new_text = Replace(new_text, "Service", "Serv")
new_text = Replace(new_text, "Group", "")
new_text = Replace(new_text, "Object", "Obj")
new_text = Replace(new_text, "DEF_errnt", "")
new_text = Replace(new_text, " DEF_errunix", "")
new_text = Replace(new_text, "Time of Last State Change", "")
new_text = Replace(new_text, "First Received", "F R")
new_text = Replace(new_text, "Last Received", "L R")
new_text = Replace(new_text, "serveur", "Srv")
new_text = Replace(new_text, "User of Last State Change", "")
new_text = Replace(new_text, "ATTENTE", "Att")
new_text = Replace(new_text, "fichier", "file")
new_text = Replace(new_text, "Remontée d'alerte xxxxx", "sur")
new_text = Replace(new_text, "ERREUR", "ERR")
new_text = Replace(new_text, "erreur", "ERR")
new_text = Replace(new_text, "est en ERR", "ERR")
new_text = Replace(new_text, "Ticket ", "")
new_text = Replace(new_text, "PM", "")
new_text = Replace(new_text, "AM", "")
new_text = Replace(new_text, "sur", "")
new_text = Replace(new_text, " Owner", "")
new_text = Replace(new_text, "les jobs suivants sont concernés", "sur jobs")
new_text = Replace(new_text, "minutes", "mm")
new_text = Replace(new_text, ":", "")
'new_text = Replace(new_text, "-", "")
new_text = Replace(new_text, ". ", "")
new_text = Replace(new_text, "  ", " ")
new_text = Replace(new_text, "   ", "")
Cellule.Value = new_text
End If
Next
'MsgBox "Fini!"
End Sub

Bonjour,

je te suggère alors :
Code:

1 2 3 If cellule.value like "##/##/#### #*" then cellule.value = "" end if
si la cellule ne contient que celà.
Si elle contient cela et autre chose, tu dis ... et je te suggèrerai autre chose

EDIT :
alors voilà, juste pour le cas où :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Dim toto As String, titi As String, cpt As Integer toto = "blablabla 12/01/2000 12345 blibli" titi = toto cpt = 0 If toto Like "*##/##/#### #*" Then While Not titi Like "##/##/#### #*" cpt = cpt + 1 titi = Mid(titi, 2) Wend titi = Mid(titi, 11) While IsNumeric(Mid(titi, 1, 1)) Or Mid(titi, 1, 1) = " " titi = Mid(titi, 2) Wend End If MsgBox Left(toto, cpt) & titi
où, bien évidemment :
toto est à remplacer par le contenu de ta cellule, à laquelle, à la fin, tu donnes la valeur de Left(toto, cpt) & titi.

BOnjour,

merci pour ton aide.

j'aimerais savoir pourquoi en modifiant ta macro ( voir code ci-dessous ) cela ne fonctionne plus ?

et comment remplacer la msgbox par une réécriture en B6 apres traitement.

merci de ton aide.

Bonne journée.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Dim toto As String, titi As String, texte As String, cpt As Integer texte = [b6] toto = texte titi = toto cpt = 0 If toto Like "*##/##/#### #*" Then While Not titi Like "##/##/#### #*" cpt = cpt + 1 titi = Mid(titi, 2) Wend titi = Mid(titi, 11) While IsNumeric(Mid(titi, 1, 1)) Or Mid(titi, 1, 1) = " " titi = Mid(titi, 2) Wend End If MsgBox Left(toto, cpt) & titi

31/10/2008, 07h50
ucfoutu
Euh...

C'esr dans ta boucle (que tu as déjà écrite), que se trouve ta réponse ...

Voici ce que tu as écrit :
Code:

1 2 3 4 For Each Cellule In Range("b6:b6") If Cellule.Value then <> "" ....... Next
toto , c'est cellule.value
donc :
Code:

1 2 3 4 5 6 7 8 For Each Cellule In Range("b6:b6") If Cellule.Value <> then "" toto = celule.value ... la suite de mon code .... celule.value = Left(toto, cpt) & titi ... next
Toto (que tu n'es pas obligé d'adopter, est tout simplement ce que tu as, toi, baptisé old_text ...:lol:

J'en profite (rien à voir avec mon code) pour te signaler le danger potentiel de ta ligne de code de remplacement suivante :

Code:

new_text = Replace(new_text, "AM", "")

ok donc ça donne :

mais la ça ne marche plus je ne comprends pas pour quoi, les date jj/mm/aaaa 123456 ne se supprime pas . ??

Code:

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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
Sub retourchariot()
 
Dim old_text As String
Dim new_text As String
 
ActiveCell.SpecialCells(xlLastCell).Select
DerCell = ActiveCell.Address
Range("b6:b6").Select
 
For Each Cellule In Range("b6:b6")
If Cellule.Value <> "" Then
old_text = Cellule.Value
new_text = Replace(old_text, Chr(10), " ") 'élimine les sauts de ligne
new_text = Replace(new_text, Chr(13), " ") 'élimine les retours a la ligne
new_text = Replace(new_text, Chr(34), " ") 'élimine les guillemets
'new_text = Replace(new_text, Chr(44), " ") 'élimine les virgules
'new_text = Replace(new_text, Chr(59), " ") 'élimine les points virgules
new_text = Replace(new_text, "Message Text:", "Mess:")
new_text = Replace(new_text, "Severity:  Critical Node:", "")
new_text = Replace(new_text, "alerte hpov w2k", "")
new_text = Replace(new_text, "  . ", "")
new_text = Replace(new_text, "Application:", "Appli:")
new_text = Replace(new_text, "de l'application", "l'appli")
new_text = Replace(new_text, "alerte controlm", "Ctrlm")
new_text = Replace(new_text, "Alerte controlm", "Ctrlm")
new_text = Replace(new_text, " (*) NS3", "")
new_text = Replace(new_text, " (*) NS4", "")
new_text = Replace(new_text, "State: Active Service:", "")
new_text = Replace(new_text, "Destinataire", "Dest")
new_text = Replace(new_text, "Node", "")
new_text = Replace(new_text, "Transfert", "Trans")
new_text = Replace(new_text, " Owner", "")
new_text = Replace(new_text, "numéro", "n°")
new_text = Replace(new_text, "Service", "Serv")
new_text = Replace(new_text, "Group", "")
new_text = Replace(new_text, "Object", "Obj")
new_text = Replace(new_text, "DEF_errnt", "")
new_text = Replace(new_text, " DEF_errunix", "")
new_text = Replace(new_text, "Time of Last State Change", "")
new_text = Replace(new_text, "First Received", "F R")
new_text = Replace(new_text, "Last Received", "L R")
new_text = Replace(new_text, "serveur", "Srv")
new_text = Replace(new_text, "User of Last State Change", "")
new_text = Replace(new_text, "ATTENTE", "Att")
new_text = Replace(new_text, "fichier", "file")
new_text = Replace(new_text, "Remontée d'alerte xxxxx", "sur")
new_text = Replace(new_text, "ERREUR", "ERR")
new_text = Replace(new_text, "erreur", "ERR")
new_text = Replace(new_text, "est en ERR", "ERR")
new_text = Replace(new_text, "Ticket ", "")
new_text = Replace(new_text, "PM", "")
new_text = Replace(new_text, "AM", "")
new_text = Replace(new_text, "sur", "")
new_text = Replace(new_text, " Owner", "")
new_text = Replace(new_text, "les jobs suivants sont concernés", "sur jobs")
new_text = Replace(new_text, "minutes", "mm")
new_text = Replace(new_text, ":", "")
'new_text = Replace(new_text, "-", "")
new_text = Replace(new_text, ". ", "")
new_text = Replace(new_text, "  ", " ")
new_text = Replace(new_text, "   ", "")
Cellule.Value = new_text
 
'ajout modif date
toto = old_text
titi = toto
    cpt = 0
  If toto Like "*##/##/#### #*" Then
    While Not titi Like "##/##/#### #*"
      cpt = cpt + 1
      titi = Mid(titi, 2)
    Wend
    titi = Mid(titi, 11)
    While IsNumeric(Mid(titi, 1, 1)) Or Mid(titi, 1, 1) = " "
      titi = Mid(titi, 2)
    Wend
  End If
  Cellule.Value = Left(toto, cpt) & titi
End If
Next
'MsgBox "Fini!"
End Sub

31/10/2008, 09h14
ucfoutu
Que t'affiche donc :
Code:

1 2 toto = old_text msgbox toto
pour l'une des cellules concernées ?
Ta réponse nous éclairera surement

Edit :
En outre : attention !
au niveau où tu as inséré mon code, ta cellule n'a déjà plus la même valeur, puisqu'elle a subi des replace !...
A ce niveaun ce n'est plus
toto = old-text
mais toto = new-text
(ou encore toto = cellule.value)
31/10/2008, 09h22
slorgue

La msgbox m'affiche bien le contenu de la cellule B6 avec les dates.
31/10/2008, 09h25
ucfoutu

Montre, s'il te plait, le texte exact et complet (tout le contenu) reçu en message.
copie-le sur un papier avec soin et frappe-le ici....
31/10/2008, 09h31
slorgue

J'ai rien dis désolé du temps perdu mais j'ai 2 format de date j'ai jj/mm/aaaa et j'ai aussi aaa/mm/jj

vraiment désolé.

merci de ton aide.
31/10/2008, 09h32
ouskel'n'or

Tu ne veux traiter que la cellule B6 ? Ta boucle, là, ne concerne que cette cellule et si ton remplacement fonctionne, il ne fonctionnera que sur cette cellule (!?!)

Code:

For Each Cellule In Range("b6:b6")

Peux-tu nous reformuler ton pb ?
A+
31/10/2008, 09h37
ucfoutu

Ah !....
voilà donc la cause !
Bon ...
ou tu te sens apte à modifier mon code pour traiter les deux cas et je te laisse
ou tu ne t'en sens pas la force et je te le fais dans deux heures

Si tui le fais toi : essaye d'éviter (c'est possible) de traiter les deux cas de manière séparée (pour soulager le traitement) ....;)
tu dis ...;)
31/10/2008, 09h47
slorgue

ben traiter separement ça je peu mais dans la meme macro non désolé je ne vois .

merci encore.

Bonne journée.
31/10/2008, 09h49
ouskel'n'or

Citation:

Envoyé par ousk'... il a dit :

Peux-tu nous reformuler ton pb ?
31/10/2008, 10h27
slorgue

iln'y a plus de probleme .

mais en gros je voulais supprimer dans une cellule une chaine de caractere noyée dans du texte la chaine a supprimer etait du style jj/mm/aaaa 12345 .

Voila

bonne journée et merci encore.

Chose promise étant chose due,

voilà de quoi traiter d'un seul coup les deux cas de figure :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Dim toto As String, titi As String, cpt As Integer 'toto = "blabla 20/12/2000 34121 blibli" toto = "blabla 2000/12/20 34121 blibli" titi = toto cpt = 0 If toto Like "*##/##/#### #*" Or toto Like "*####/##/## #*" Then While Not titi Like "##/##/#### #*" And Not titi Like "####/##/## #*" cpt = cpt + 1 titi = Mid(titi, 2) Wend titi = Mid(titi, 11) While IsNumeric(Mid(titi, 1, 1)) Or Mid(titi, 1, 1) = " " titi = Mid(titi, 2) Wend End If MsgBox Left(toto, cpt) & titi
Maintenant, si en plus tu as plusieurs dates de ce(s) format(s) dans une même cellule et que tu veux toutes les traiter, ce sera un tout petit peu plus compliqué, mais pas de problème, je saurai utiliser alors la récursivité et les traiter toutes dans la même routine.
Bonne journée.

31/10/2008, 11h15
slorgue

grand merci a toi et oui j'ai plusieurs dates dans la meme cellule. ;-)

merci beaucoup de ton aide.

Ah ah ....
plusieurs dates de l'espèce dans la même cellule ...
Voilà qui commence à devenir rigolo et intéressant ...:king:

On y va alors ...
tu vas en profiter pour "goûter" à la récursivite (fonction récursive) ;) :Voilà comment traiter (où notre ami toto est, bien sûr, le contenu de ta cellule ) :

Code:

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
Option Explicit
Private Sub Command1_Click()
  Dim toto As String
  toto = "blabla 2000/12/20 34121 blibli bloblo 20/12/2000 34121 blublu"
  MsgBox epurons(toto)
End Sub
 
Private Function epurons(c As String) As String
  Dim titi As String, cpt As Integer
  titi = c
  If titi Like "*##/##/#### #*" Or titi Like "*####/##/## #*" Then
    cpt = 0
      While Not titi Like "##/##/#### #*" And Not titi Like "####/##/## #*"
        cpt = cpt + 1
        titi = Mid(titi, 2)
      Wend
      titi = Mid(titi, 11)
      While IsNumeric(Mid(titi, 1, 1)) Or Mid(titi, 1, 1) = " "
        titi = Mid(titi, 2)
    Wend
  End If
  epurons = Left(c, cpt) & titi
  If epurons Like "*##/##/#### #*" Or epurons Like "*####/##/## #*" Then
    epurons = epurons(epurons) '<<<<<===== Intéressant, non ?
  End If
End Function

Bonne fin de semaine et merci de m'avoir donné un peu de plaisir...;)

bonjour,

tu peu aussi utiliser une expression réguliére, rajoute 'Microsoft VBScript Regular expression 5.5" comme référence à ton classeur puis :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 
Sub retourchariot()
 Dim reg As New VBScript_RegExp_55.RegExp
'( ...)
For Each Cellule In Range("b6:b6")
'(..)
  reg.Pattern = "(\d\d/\d\d/\d\d\d\d \d\d\d\d)"
  reg.MultiLine = True
  reg.Global = True
   If reg.Test(Cellule) Then
    Cellule.Value = reg.Replace(Cellule, "")
  End If
Next
'(..)
end Sub

31/10/2008, 12h08
slorgue

grand merci et bon week end.

Bien...

J'avais un peu décomposé la fonction epurons pour te permettre de la suivre .

On va passer au cran au dessus en .... épurant maintenant la fonction epurons ...

Ainsi :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Private Function epurons(c As String) As String
  Dim titi As String, cpt As Integer
  epurons = c
  While epurons Like "*##/##/#### #*" Or epurons Like "*####/##/## #*"
    titi = epurons
    cpt = 0
      While Not titi Like "##/##/#### #*" And Not titi Like "####/##/## #*"
        cpt = cpt + 1
        titi = Mid(titi, 2)
      Wend
      titi = Mid(titi, 11)
      While IsNumeric(Mid(titi, 1, 1)) Or Mid(titi, 1, 1) = " "
        titi = Mid(titi, 2)
    Wend
    epurons = Left(epurons, cpt) & titi
    DoEvents
    epurons = epurons(epurons)
  Wend
End Function

Voilà, ===>> c'est à peine un peu plus dur, mais compréhensible ... étudie cette fonction calmement ;)