Discussion :

[1pim34]

Bonjour à tous,

Je cherche à faire un remplacement de certains caractères par d'autres dans une cellule. Voici ce que j'utilise et cela fonctionne très bien :

Code :

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

1
2
3
4
5
6
With Worksheets("OLEA").Columns("E") 'Recodification comptes comptables
 
        .Replace What:=4111, Replacement:="'01", SearchOrder:=xlByColumns, MatchCase:=True
        .Replace What:=4018, Replacement:="'08", SearchOrder:=xlByColumns, MatchCase:=True
 
End With

Mon but étant en fait de faire ce remplacement uniquement si la chaine de caractère "4111" ou "4081" est au début de la valeur de la cellule dans ma colonne E :

4111504650
44586000
16410000
51100000
4111504111
44566000
16410000

Dans l'exemple ci dessus, je ne souhaite pas que soit remplacé le 4111 coloré en rouge.

Merci d'avance.

[BENNASR]

bonjour
à tester sur une copie pour munir contre tt risque de perte de donnée

Code :

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

1
2
3
4
5
6
7
8
Sub testtt()
Dim C As Range
Dim plage As Range
Set plage = Range("E1:E10")
For Each C In plage
If Left(C.Value, 4) = 4111 Then C.Value = Replace(C.Value, "4111", "'05", 1, 1, 0)
Next C
End Sub

[1pim34]

Merci pour la réponse. Ca semble bien fonctionner.
Est-il possible à quoi correspondent les différents arguments de la fonction ?

Pour faire la totalité de ce que je souhaitais faire, voila ce que j'ai fait :

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
'Recodification codes journaux
    Dim A As Range
    Dim plage1 As Range
    Set plage1 = Range("A:A")
    For Each A In plage1
        If A.Value = B1 Then A.Value = BP
    Next A
 
    Dim B As Range
    Dim plage2 As Range
    Set plage2 = Range("A:A")
    For Each B In plage2
        If B.Value = B2 Then B.Value = RC
    Next B
 
 
'Recodification comptes comptables
    Dim D As Range
    Dim plage3 As Range
    Set plage3 = Range("E:E")
    For Each D In plage3
        If D.Value = 44571251 Then D.Value = 4457100
    Next D
 
 
 
    Dim C As Range
    Dim plage As Range
    Set plage = Range("E:E")
    For Each C In plage
        If Left(C.Value, 4) = 4111 Then C.Value = Replace(C.Value, "4111", "'01", 1, 1, 0)
    Next C
 
    Dim E As Range
    Dim plage4 As Range
    Set plage4 = Range("E:E")
    For Each E In plage
        If Left(E.Value, 4) = 4081 Then E.Value = Replace(E.Value, "4081", "'08", 1, 1, 0)
    Next E

Cela fonctionne mais me semble très long.

quelqu'un aurait-il une optimisation à me proposer ? Avec une explication en prime pour que je comprenne ce que je peux optimiser.

Merci d'avance.

[BENNASR]

tester ça :
NB : n'oubliez pas de modifier le nom de l'onglet , dans le code égal à feuil1

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
Sub test()
Dim F As Worksheet
Dim A As Range
Dim plage1 As Range
Dim derligA As Long
Dim derligE As Long
Dim plage3 As Range
Dim D As Range
 
Set F = Sheets("Feuil1") ' à adapter
derligA = F.Range("A" & Rows.Count).End(xlUp).Row
Set plage1 = F.Range("A2:A" & derligA)
derligE = F.Range("E" & Rows.Count).End(xlUp).Row
Set plage3 = Range("E2:E" & derligE)
 
Application.ScreenUpdating = False 'arrêter affichage écran pour gagner en temps d'exécution
 
For Each A In plage1
If A.Value = B1 Then A.Value = BP
If A.Value = B2 Then A.Value = RC
Next A
 
'Recodification comptes comptables
For Each D In plage3
If D.Value = 44571251 Then D.Value = 4457100
If Left(D.Value, 4) = 4111 Then D.Value = Replace(D.Value, "4111", "'01", 1, 1, 0)
If Left(D.Value, 4) = 4081 Then D.Value = Replace(D.Value, "4081", "'08", 1, 1, 0)
Next D
Application.ScreenUpdating = True
End Sub

[fraflt69]

Bonjour
Si le nombre de remplacements est fini (moins de 10). Une formule avec des FIND et des REPLACE (sans VBA) permet de faire la même chose. Attention je ne suis pas spécialiste.

[1pim34]

Merci à vous 2,
@fraflt69 : malheureusement le fichier d'origine est assez lourd.
@BENNASR : Merci, je vais essayer cette nouvelle version. Sur un petit fichier de 900 lignes ma version prend 1 minute 30 sec.