Boucle While avec incrémentation : vba excel

Résolu/Fermé

Nours85 - 17 juil. 2008 à 08:58
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 - 17 juil. 2008 à 17:35

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 lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
17 juil. 2008 à 09:31

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

Réponse 2 / 3

gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 684
17 juil. 2008 à 17:35

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.

Réponse 3 / 3

Nours85
17 juil. 2008 à 11:22

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

Discussions similaires

[BASH] Existe t-il un boucle do while?

Mon pc s'allume et s'éteint en boucle

recopier une formule sans décalage

Factorielle en langage C (avec boucle)

Redémarrage en boucle Xiamo mi note 10

Discussions similaires

Newsletters