Macro rechercher - remplacer

**Bchiko** · 13/06/2016, 10h32

Bonjour a tous,

Suite a une création de macro je rencontre un problème avec la fonction "rechercher-remplacer" :

Dans les colonnes A,B & K j'ai paramétré ma macro pour que les "," ";" "/" " " soit remplacé par des "." ( mes cellules sont au format texte). Tout fonctionne pour la colonne K par contre pour les colonnes A&B il me remplace tout avec des ",".

Voici la macro :

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
Sub Macro6()
'
' Macro6 Macro
'
 
'
    Range("I2:I30").Select
    Selection.Replace What:="/", Replacement:=".", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=";", Replacement:=".", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=" ", Replacement:=".", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=",", Replacement:=".", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range("A2:B30").Select
    Selection.Replace What:=",", Replacement:=".", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=" ", Replacement:=".", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=";", Replacement:=".", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="/", Replacement:=".", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range("E16").Select
    ActiveWorkbook.Save
    ActiveWindow.SmallScroll Down:=12
    Range("B32:C34").Select
    Range("C34").Activate
End Sub

J'ai parcouru le forum pour trouver de l'aide mais rien ne ma été d'une aide (malgré le post d'un membre ayant rencontré un problème similaire).

Auriez-vous une solution a mon problème ?

Merci de votre aide bonne journée a tous.

**Docmarti** · 13/06/2016, 16h09

Bonjour.

S'il y a des nombres ou des dates et que tu veux des valeurs de type String comme résultat, il faut utiliser Application.Substitute et non Replace.

Code :

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

1
2
3
Set r = Range("A2:B30")
tt = Application.Substitute(r, ",", ".")
r.Value = tt

Tout ton code pourrait être remplacé par :

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
Sub remplacer2()
 
Set f = ThisWorkbook.Worksheets("Feuil1")
 
quoi = Array("/", ";", " ", ",")
 
parquoi = "."
 
Set r = f.Range("I2:I30")
Call Substituer(r, quoi, parquoi)
 
Set r = Range("A2:B30")
Call Substituer(r, quoi, parquoi)
 
End Sub
 
Sub Substituer(r, quoi, parquoi)
 
For i = LBound(quoi) To UBound(quoi)
 tt = Application.Substitute(r, quoi(i), parquoi)
 r.Value = tt
Next
 
End Sub

**Bchiko** · 14/06/2016, 14h46

Bonjour Doc !!!!

Merci pour les lignes !!!! Ca marche au poil, en effet vue que ces remplacement doivent se faire pour des dates Excel ne le comprenais pas (05/2016 , 35/2016 => 05.2016 , 35.2016).

Voici le code au complet :

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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
Sub Remplissage()
'
' Remplissage Macro
' Remplis automatiquement les colonnes H K P Q R S T et converti\normalise les colonnes A B I et sauvegarde une copie du fichier daté au format XLS
'
 
'
    Range("K2").Select
    ActiveCell.FormulaR1C1 = "AJOUT 48H"
    Range("K2").Select
    Selection.Copy
    Range("K3:K30").Select
    ActiveSheet.Paste
    Range("H2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "ENTP"
    Range("H2").Select
    Selection.Copy
    Range("H3:H30").Select
    ActiveSheet.Paste
    Range("P2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "D"
    Range("Q2").Select
    ActiveCell.FormulaR1C1 = "2"
    Range("R2").Select
    ActiveCell.FormulaR1C1 = "I"
    Range("S2").Select
    ActiveCell.FormulaR1C1 = "PCE"
    Range("T2").Select
    ActiveCell.FormulaR1C1 = "PCE"
    Range("P2:T2").Select
    Selection.Copy
    Range("P3:P30").Select
    ActiveSheet.Paste
    ActiveWindow.ScrollColumn = 1
    Range("A2:A30").Select
    Application.CutCopyMode = False
    Selection.NumberFormat = "@"
    Range("B2:B30").Select
    Selection.NumberFormat = "@"
    Range("A2:A30").Select
    Selection.NumberFormat = "@"
    Range("I2:I30").Select
    Selection.NumberFormat = "@"
    Range("G2").Select
 
 
       ActiveWindow.SmallScroll Down:=-27
    Range("I2:I30").Select
    Selection.Replace What:=" ", Replacement:=".", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=",", Replacement:=".", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=";", Replacement:=".", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="/", Replacement:=".", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    ActiveWindow.SmallScroll Down:=-24
    Range("A2:B30").Select
    Selection.Replace What:="/", Replacement:=".", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=",", Replacement:=".", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=";", Replacement:=".", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=" ", Replacement:=".", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        Set r = Range("A2:B30")
    tt = Application.Substitute(r, ",", ".")
    r.Value = tt
 
 
    Range("A31").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.ClearContents
    ActiveCell.FormulaR1C1 = ""
    Range("E34").Select
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 14
    ActiveWindow.ScrollColumn = 15
    ActiveWindow.ScrollColumn = 16
    ActiveWindow.SmallScroll Down:=-48
    Range("AC1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlUp)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    ActiveCell.FormulaR1C1 = ""
    Range("AC31").Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Selection.ClearContents
    ActiveCell.FormulaR1C1 = ""
    Range("AC31").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlUp)).Select
    Selection.ClearContents
    Selection.ClearContents
    ActiveCell.FormulaR1C1 = ""
    Range("AC33").Select
 
Dim Path As String, valeur As String
Path = ActiveWorkbook.Path & "\"
valeur = "Fichier injection AJOUT48H ENTREPOT_" & Format(Date, "dd-mmmm-yyyy") & "_" & Format(Time, "hh-mm") & ".csv"
ThisWorkbook.SaveAs Path & valeur
MsgBox ("Le fichier a été enregistré sous : " & Path & nom)
 
End Sub

Merci beaucoup encore une fois !!! J'espère que ce topic aidera d'autre personne pour la même occasion.

Macro rechercher - remplacer [XL-2013]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager