fonction "replace" et chaine de caractère

**slorgue** · 30/10/2008, 15h05

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**ucfoutu** · 30/10/2008, 19h00

Bonjour,

je te suggère alors :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

**slorgue** · 31/10/2008, 07h31

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**ucfoutu** · 31/10/2008, 07h50

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
For Each Cellule In Range("b6:b6")
  If Cellule.Value then <> "" 
.......
Next

toto , c'est cellule.value
donc :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 ...

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**slorgue** · 31/10/2008, 09h07

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**ucfoutu** · 31/10/2008, 09h14

Que t'affiche donc :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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)

fonction "replace" et chaine de caractère

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager