Boucle While avec incrémentation : vba excel

Résolu
Nours85 -  
gbinforme Messages postés 14946 Date d'inscription   Statut Contributeur Dernière intervention   -
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
A voir également:

3 réponses

Réponse 1 / 3
gbinforme Messages postés 14946 Date d'inscription   Statut Contributeur Dernière intervention   4 724
 
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
Réponse 2 / 3
gbinforme Messages postés 14946 Date d'inscription   Statut Contributeur Dernière intervention   4 724
 
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.
1
Réponse 3 / 3
Nours85
 
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
0