Discussion :

[Thomas88-67]

Bonjour,

Je suis nouveau sur le forum et débutant en VBA.

Je souhaite insérer une boucle permettant de remplacer par un vide lorsque deux cellules ou plus se suivant contiennent le même mot.

J'ai essayé ce code:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Dim i As Integer
i = 1
Range("D2").Activate
Do While Not (IsEmpty(ActiveCell))
    If Worksheets("Feuil1").Range("D" & i + 1).Value <> "" And Worksheets("Feuil1").Range("D" & i + 1).Value = Worksheets("Feuil1").Range("D" & i) Then
        Range("D" & i + 1).Value = ("")
        Else
    i = i + 1
    End If
 
 Loop
 
End Sub

Cependant deux problèmes :
1) Dépassement de capacité (je pense que la boucle est mal bornée)
2) Va fonctionner pour la cellule D4 mais par pour D5

Pourriez vous m'aider.

En vous remerciant d'avance,

[Philippe Tulliez]

Bonjour,
Comme tu n'indiques pas où a lieu (quelle ligne) le dépassement de capacité, il est difficile de t'aider.
Cependant d'instinct, je me dis qu'il est probable que cela vienne de la variable I qui est typée comme Integer et qu'elle a sans doute dépassé la valeur maximale d'un entier
Quand une variable représente une ligne, je privilégie le type Long

Quant au remplacement de chaîne de caractères par une chaîne vide ne pourrais-tu pas utiliser la méthode Replace ?
Cela éviterait la boucle

[Menhir]

Il y a de nombreux problèmes dans ton code.

D'abord, tu donnes comme condition de sortie de ta boucle un test sur la cellule active. Or rien dans ta boucle ne modifie la cellule qui est active.
Donc, si le code entre dans la boucle il n'en sortira jamais.
Et comme ton i est un Integer, au bout de 32 000 tours, ton exécution explose en vol.

Ensuite, tu n'incrémentes la variable d'itération (i) que si le test est négatif, ce qui fait faire à ta boucle des tours pour rien.

[Thomas88-67]

Merci à vous deux pour ces premiers retour, cela m'a permis de modifier le code comme ceci:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Dim i As Long
i = 1
Range("D2").Activate
 'Boucle tant que pas vide
Do While Not Worksheets("Feuil1").Range("A" & i).Value = ""
    If Worksheets("Feuil1").Range("D" & i + 1).Value = Worksheets("Feuil1").Range("D" & i) Then
        Range("D" & i + 1).Value = (",")
    Else
    i = i + 1
    End If
 Loop

Cela fonctionne mais uniquement si il y a deux valeurs qui se suivent, auriez vous une idée si il y en a plus de deux qui se suivent ?

[Philippe Tulliez]

Bonjour,
Même remarque que Menhir même si la condition a changé. L'incrémentation du I se fait dans le else donc le code fait du surplace

[Algoplus]

Bonjour à tous,

si on a 3 valeurs identiques en D2,D3,D4 (par exemple) avec ce code on test D2 et D3 => identique donc on efface D3. on incrémente i, on passe à D3. on compare D3 et D4 => pas identique donc on incrémente i ....

Au final on aura la même valeur en D2 et D4.

Dans ces cas de modifications (suppressions...) il est souvent plus facile de commencer par la fin du fichier:

On teste D4 et D3 : identique donc on efface D4
on teste D3 et D2 : identique donc on efface D3
on teste D2 et D2 : pas identique donc on n'efface pas.

Il faudrait utiliser une boucle for next entre le N° de la dernière ligne de données et 1 ( step -1 sinon ça ne marche pas).
ça évite en plus de gérer l'incrémentation de i.

[Thomas88-67]

Bonjour à tous,

Je vous remercie pour vos différentes réponses.
Grace à vos observations voici la boucle :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Dim i As Long
i = 20
Range("D20").Activate
 'Boucle tant que pas vide
Do While Worksheets("Feuil1").Range("D" & i).Value <> "Type"
    If Worksheets("Feuil1").Range("D" & i).Value = Worksheets("Feuil1").Range("D" & i - 1) Then
        Range("D" & i).Value = (",")
    Else
    i = i - 1
    End If
 
 Loop

Elle semble fonctionner, mais est elle bien écrite ? peut elle amener à des problèmes ?

[Algoplus]

Ca fonctionne... oui.... mais ...

pour chaque valeur de i combien de fois parcours-t-on la boucle ?!

tu n'as pas pris en compte la remarque de Philippe Tulliez

[Thomas88-67]

Merci Algoplus;

J'essaie de prendre en compte la remarque de Philippe Tulliez mais je n'arrive pas à rectifier et à construirai un code qui fonctionne.

Pourriez vous m'aider sur un code qui fonctionnerait ?

Merci d'avance,

[Philippe Tulliez]

Bonjour,
Le If...Then...Else signifie que si la condition est remplie (True) on exécute un certain nombre de tâches sinon (Else) on exécute d'autres tâches.
Tu as donc mis des instructions de lecture de cellules se trouvant sur une ligne définie par la variable I (initialisée à 20 avant de commencer) si la condition est remplie et si pas tu incrémentes la variable I donc dès que la condition renvoie True comme I ne sera pas incrémentée l'instruction de lecture reste sur la ligne définie par I

Autrement dit l'instruction I=I+1 doit se trouver en dehors de la condition (If...Then...Else).

Est-ce plus clair ?

[Theze]

Bonjour,

Pars plutôt depuis le bas de ta plage en bornant bien cette dernière par recherche de la dernière cellule non vide :

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 I As Long
Dim Lig As Long
 
With Worksheets("Feuil1")
 
    Lig = .Cells(.Rows.Count, 4).End(xlUp).Row
 
    For I = Lig To 2 Step -1
 
        If .Cells(I, 4).Value = .Cells(I - 1, 4).Value Then .Cells(I, 4).Value = ""
 
     Next I
 
End With

Le dépassement de capacité vient du fait que tu incrémentes i sans déplacer ta cellule active :

Code :

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

1
2
3
4
5
6
7
8
9
 
Do While Not (IsEmpty(ActiveCell))'ici, la cellule active ne bouge pas !
    If Worksheets("Feuil1").Range("D" & i + 1).Value <> "" And Worksheets("Feuil1").Range("D" & i + 1).Value = Worksheets("Feuil1").Range("D" & i) Then
        Range("D" & i + 1).Value = ("")
        Else
    i = i + 1'<-----et ici, tu incrémentes donc, avec un entier, arrivé à 32768, il y a dépassement de capacité puisque maxi 32767
    End If
 
 Loop

[Thomas88-67]

Merci beaucoup à vous, et merci a toi Thèse cela fonctionne très bien.