Boucle While avec incrémentation : vba excel [Résolu/Fermé]

Signaler
-
Messages postés
14934
Date d'inscription
lundi 18 octobre 2004
Statut
Contributeur
Dernière intervention
24 juin 2020
-
Bonjour,
Il y a longtemps que je n’ai pas utilisé le langage vba mais aujourd’hui j’en ai besoin et ça ne revient pas si vite que ça.
Voilà mon problème :
Je possède 2 séries de valeurs (« tableaux ») sur la même feuille Excel.
Voici un petit schéma :

A B C
Article / Catégorie / Poids
1 cat1 2.35
1 cat1 2.36
2 cat3 2.40
4 cat1 2.35
6 cat1 2.35

F G H
Article / Catégorie / Poids
1 cat1 2.35
1 cat1 2.36
2 cat3 2.40
3 cat2 2.38
3 cat1 2.35
4 cat1 2.35
5 cat1 2.35
5 cat1 2.35
6 cat1 2.35

(A B C) et (F G H) sont les colonnes du tableau. J’aimerais comparer la valeur de la cellule (A,1) avec celle de la cellule (F,1). Si elles sont identiques, on passe à la suivante, c’est à dire comparer la valeur de la cellule (A,2) avec (F,2)
Si elles sont différentes, je souhaiterais supprimer la cellule (F,1) et remonter les cellules du dessous vers le haut pour à nouveau comparer la cellule (A,1) avec la cellule (F,1) (qui était (F,2) avant). Je ne sais pas si je suis très clair mais voici le tableau que je souhaiterais obtenir à la fin.

A B C
Article / Catégorie / Poids
1 cat1 2.35
1 cat1 2.36
2 cat3 2.40
4 cat1 2.35
6 cat1 2.35

F G H
Article / Catégorie / Poids
1 cat1 2.35
1 cat1 2.36
2 cat3 2.40
4 cat1 2.35
6 cat1 2.35

J’ai essayer d’utiliser la boucle « tant que » While.

En français :
De j = 4
Tant que la cellule ( j,1) est différente de la cellule (j,6)
Supprimer les cellules (j,6) (j,7) (j,8)
Quand la cellule ( j,1) est égale à la cellule (j,6)
On incrémente j de 1

Ou sinon on peut comparer (j,1) avec (j,6), (j,7)….(j,10) et tant qu’il n’a pas trouver une valeur identique on arrête pas, dès que les valeurs sont égales, on supprime toutes les valeurs au dessus et on remonte vers le haut.

J’ai essayer en vba mais ça doit pas être ça car ça fonctionne pas
Sub NA()
j = 4
Do While Cells(j, 1).Value <> Cells(j, 6).Value
Cells(j, 6).Delete
Cells(j, 7).Delete
Cells(j, 8).Delete
j = j + 1
Exit Do
Loop
End Sub

Merci de me conseiller

3 réponses

Messages postés
14934
Date d'inscription
lundi 18 octobre 2004
Statut
Contributeur
Dernière intervention
24 juin 2020
4 475
bonjour

Avec une petite modification cela devrait te donner satisfaction :
Sub NA()
Dim j As Long
j = 4
Do While Cells(j, 1).Value <> "" And Cells(j, 6).Value <> ""
    If Cells(j, 1).Value <> Cells(j, 6).Value Then
        Cells(j, 6).Resize(1, 3).Delete
    Else
        j = j + 1
    End If
Loop
End Sub
5
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 65492 internautes nous ont dit merci ce mois-ci

Messages postés
14934
Date d'inscription
lundi 18 octobre 2004
Statut
Contributeur
Dernière intervention
24 juin 2020
4 475
bonjour

Cette instruction équivaut à toute ta série de delete mais si tu aime écrire et utiliser ta machine ... c'est toi qui voit.
Cells(j, 12).Resize(1,12).Delete 


Quand tu définis ainsi, tu ne peux dépasser 32000 et il y a la possibilité d"en avoir plus du double.
Dim j As Integer 

Tu n'as pas compris le principe du else que j'avais mis et qui évite de faire moins et plus comme tu fais.
Merci pour le conseil.

Le problème est enfin résolu, voici ce que j'ai utilisé :

Sub ComparerSupprimer()

Dim j As Integer

j = Cells(1, 1).Value
While j < Cells(2, 1).Value
If Cells(j, 1).Value <> Cells(j, 12).Value And Cells(j, 12).Value <> "" Then
Cells(j, 12).Delete
Cells(j, 13).Delete
Cells(j, 14).Delete
Cells(j, 15).Delete
Cells(j, 16).Delete
Cells(j, 17).Delete
Cells(j, 18).Delete
Cells(j, 19).Delete
Cells(j, 20).Delete
Cells(j, 21).Delete
Cells(j, 22).Delete
j = j - 1
limit = limit - 1
End If
j = j + 1
Wend

End Sub

Merci