[VBA] Problème de boucle ?

Résolu/Fermé
Messages postés
1561
Date d'inscription
jeudi 19 juillet 2007
Statut
Membre
Dernière intervention
30 avril 2019
-
Messages postés
1561
Date d'inscription
jeudi 19 juillet 2007
Statut
Membre
Dernière intervention
30 avril 2019
-
Bonjour,
J'ai un problème très précis:

J'aimerai faire ceci :
on a une colonne Qte dans un tableau excel,
je veux que chaque case de la colonne soit vérifiée et jusqu'à la dernière (<>"") et a chaque fois qu'on passe à la cellule d'en dessous , on l'y additionne.
Seulement, il faut qu'avant que l'addition de chaque ligne successivement dépasse 16500 en effet on saute une ligne chaque fois que la somme total des cellules additionnées ne dépasse 16500 donc on saute une ligne avant la case qui fera dépasser 16500.
Help mes boucles sont mal faites ou ma variable temporaire n'est pas bonne ou mal initialisée proposez moi un bout de code svp

14 réponses

Messages postés
1561
Date d'inscription
jeudi 19 juillet 2007
Statut
Membre
Dernière intervention
30 avril 2019
275
help :(
Salut doudou95

Mets nous ton code histoire que l'on comprenne mieux ton souci

David
Messages postés
1561
Date d'inscription
jeudi 19 juillet 2007
Statut
Membre
Dernière intervention
30 avril 2019
275
Range("A2").Select
Set cel2 = Range("A1")
Do While cel2.Offset(i, 1).Value <> ""
If (cel2.Offset(i, 15).Value + pal) < 16500 Then
pal = cel2.Offset(i, 15).Value + pal
Else
Selection.EntireRow.Insert
Selection.Offset(1, 0).Select
End If
Selection.Offset(1, 0).Select
Loop
deja, ta variable pal n'est pas initialisée,
mais je ne comprend pas très bien ton problème
Je ne comprend pas non plus le principe de ton offset.
un simple cell["1","1"] te permet de recuprérer la valeur de A1
Messages postés
1561
Date d'inscription
jeudi 19 juillet 2007
Statut
Membre
Dernière intervention
30 avril 2019
275
faut que ça test jusqu'à la dernière case sachant que le fichier avec le nombre de cellules change
donc cell["1","1"] pas bon
j'ai supprimé mais j'avais initialisé a 0 pal

Range("A2").Select 'Se positionne en A2, première valeur de la colonne 1
Set cel2 = Range("A1")
pal = 0
Do While cel2.Offset(i, 1).Value <> "" 'Tant que cellule non vide faire
If (cel2.Offset(i, 15).Value + pal) < 16500 Then ' Si valeur de la cellule + pal < 16500 alors
pal = cel2.Offset(i, 15).Value + pal ' pal = valeur cellule + pal
Else ' Sinon
Selection.EntireRow.Insert ' Insérer colonne
Selection.Offset(1, 0).Select ' Passer à la ligne suivante
pal = 0 ' Initialisation de pal
End If ' Fin Si
Selection.Offset(1, 0).Select ' Passer à la ligne suivante
Loop 'Fin tant que
Messages postés
1561
Date d'inscription
jeudi 19 juillet 2007
Statut
Membre
Dernière intervention
30 avril 2019
275
je pense que c'est clair où ne comprenez vous pas ma question?
Messages postés
375
Date d'inscription
mercredi 21 mai 2008
Statut
Membre
Dernière intervention
17 octobre 2008
122
Non, c'est pas très clair, mais essaies ca :

    pal = 0
    i = 1
    Do While Cells(i, 1).Value <> "" 'Tant que cellule non vide faire
        If (cel2.Offset(i, 15).Value + pal) < 16500 Then ' Si valeur de la cellule + pal < 16500 alors
            pal = Cells(1, 15).Value + pal ' pal = valeur cellule + pal
        Else ' Sinon
            Cells(i, 1).EntireRow.Insert ' Insérer colonne
            i = i + 1
            pal = 0 ' Initialisation de pal
        End If ' Fin Si
        i = i + 1
    Loop 'Fin tant que
Messages postés
1561
Date d'inscription
jeudi 19 juillet 2007
Statut
Membre
Dernière intervention
30 avril 2019
275
ca arrive en début de colonne puis erreur => Objet requis
Messages postés
375
Date d'inscription
mercredi 21 mai 2008
Statut
Membre
Dernière intervention
17 octobre 2008
122
J'ai oublié de modifier dans le test :
    pal = 0
    i = 1
    Do While Cells(i, 1).Value <> "" 'Tant que cellule non vide faire
        If (Cells(i, 15).Value + pal) < 16500 Then ' Si valeur de la cellule + pal < 16500 alors
            pal = Cells(1, 15).Value + pal ' pal = valeur cellule + pal
        Else ' Sinon
            Cells(i, 1).EntireRow.Insert ' Insérer colonne
            i = i + 1
            pal = 0 ' Initialisation de pal
        End If ' Fin Si
        i = i + 1
    Loop 'Fin tant que


Et tu veux insérer une colonne ou une ligne Cells(i,1).EntireRow.Insert c'est pour insérer une ligne contrairement à ce que tu mets dans ton commentaire
Messages postés
1561
Date d'inscription
jeudi 19 juillet 2007
Statut
Membre
Dernière intervention
30 avril 2019
275 >
Messages postés
375
Date d'inscription
mercredi 21 mai 2008
Statut
Membre
Dernière intervention
17 octobre 2008

Comment définir pal? parce qu'il y a incompatibilité de type en erreur
Messages postés
375
Date d'inscription
mercredi 21 mai 2008
Statut
Membre
Dernière intervention
17 octobre 2008
122 >
Messages postés
1561
Date d'inscription
jeudi 19 juillet 2007
Statut
Membre
Dernière intervention
30 avril 2019

T'as quoi en colonne O ?

pal = Cells(i, 15).Value + pal
Messages postés
1561
Date d'inscription
jeudi 19 juillet 2007
Statut
Membre
Dernière intervention
30 avril 2019
275
ben un entier vu que l'on l'additionne et que l'on vérifie qu'il est inférieur a 16500
Messages postés
375
Date d'inscription
mercredi 21 mai 2008
Statut
Membre
Dernière intervention
17 octobre 2008
122
T'as essayé le mode débuggage Pas à Pas avec un espion sur Cells(i, 15) ?
Messages postés
1561
Date d'inscription
jeudi 19 juillet 2007
Statut
Membre
Dernière intervention
30 avril 2019
275
L'erreur se fait ici :
If (Cells(i, 15).Value + pal) < 16500 Then ' Si valeur de la cellule + pal < 16500 alors
Messages postés
375
Date d'inscription
mercredi 21 mai 2008
Statut
Membre
Dernière intervention
17 octobre 2008
122
Dès le premier passage ?

Qu'y a t'il et dans Cells(i,15).Value et dans pal au moment de l'erreur ?
Messages postés
1561
Date d'inscription
jeudi 19 juillet 2007
Statut
Membre
Dernière intervention
30 avril 2019
275
tu trouves :S ?
Messages postés
1561
Date d'inscription
jeudi 19 juillet 2007
Statut
Membre
Dernière intervention
30 avril 2019
275
Cells(i;15) = Qté ca a pris la ligne 1 faut que ca commence à la seconde !) et pal c'est bon c'est 0
Messages postés
375
Date d'inscription
mercredi 21 mai 2008
Statut
Membre
Dernière intervention
17 octobre 2008
122
Alors initialise ton i à 2
Messages postés
1561
Date d'inscription
jeudi 19 juillet 2007
Statut
Membre
Dernière intervention
30 avril 2019
275
pal = 0
i = 1
Do While Cells(i, 1).Value <> "" 'Tant que cellule non vide faire
If (Cells(i, 15).Value + pal) < 16500 Then ' Si valeur de la cellule + pal < 16500 alors
pal = Cells(1, 15).Value + pal ' pal = valeur cellule + pal
Else ' Sinon
Cells(i, 1).EntireRow.Insert ' Insérer colonne
i = i + 1
pal = 0 ' Initialisation de pal
End If ' Fin Si
i = i + 2
Loop 'Fin tant que


Si je remplace le 1 par ça marche pour le premier saut de ligne après ça saute une ligne mais pas avant 16500 :(
Si je laisse 1 = > incompatibilité de type
Si je mets 2 = > Sauts de lignes apparemment aléatoires
Messages postés
375
Date d'inscription
mercredi 21 mai 2008
Statut
Membre
Dernière intervention
17 octobre 2008
122
C'est pas Cells(1,15).value, mais Cells(i,15).value
Messages postés
375
Date d'inscription
mercredi 21 mai 2008
Statut
Membre
Dernière intervention
17 octobre 2008
122 >
Messages postés
375
Date d'inscription
mercredi 21 mai 2008
Statut
Membre
Dernière intervention
17 octobre 2008

Récapitulatif :

pal = 0
i = 2 ' On commence à la ligne 2
Do While Cells(i, 1).Value <> "" 'Tant que cellule non vide faire
    If (Cells(i, 15).Value + pal) < 16500 Then ' Si valeur de la cellule + pal < 16500 alors
        pal = Cells(i, 15).Value + pal ' pal = valeur cellule + pal
    Else ' Sinon
        Cells(i, 1).EntireRow.Insert ' Insérer colonne
        i = i + 1 ' Incrémentation de i car ajout de ligne
        pal = 0 ' Initialisation de pal
    End If ' Fin Si
    i = i + 1 ' Incrémentation de i pour passer à la ligne suivante
Loop 'Fin tant que
Messages postés
1561
Date d'inscription
jeudi 19 juillet 2007
Statut
Membre
Dernière intervention
30 avril 2019
275
Si je remplace le 1 par i ça marche pour le premier saut de ligne après ça saute une ligne mais pas avant 16500 :(
Messages postés
1561
Date d'inscription
jeudi 19 juillet 2007
Statut
Membre
Dernière intervention
30 avril 2019
275
Qté
4600
8000

4000
7200
5600

5100
7500

9300
10300



Voila tu vois que ca marche que pour le début après ca ne fonctionne plus correctement
Messages postés
375
Date d'inscription
mercredi 21 mai 2008
Statut
Membre
Dernière intervention
17 octobre 2008
122
Enlèves le i = i + 1 après l'insertion de ligne
Messages postés
1561
Date d'inscription
jeudi 19 juillet 2007
Statut
Membre
Dernière intervention
30 avril 2019
275 >
Messages postés
375
Date d'inscription
mercredi 21 mai 2008
Statut
Membre
Dernière intervention
17 octobre 2008

ca commence d'en bas le calcul faut le commencer en partant du début de la colonne (calculant en partant du bas ca me crée un bug au niveau de la première ligne qui est une chaine de caractères en créant à l'infini des nouvelles lignes)
Messages postés
375
Date d'inscription
mercredi 21 mai 2008
Statut
Membre
Dernière intervention
17 octobre 2008
122 >
Messages postés
1561
Date d'inscription
jeudi 19 juillet 2007
Statut
Membre
Dernière intervention
30 avril 2019

En mettant ce code ci :

    pal = 0
    i = 2
    Do While Cells(i, 1).Value <> "" 'Tant que cellule non vide faire
        If (Cells(i, 15).Value + pal) < 16500 Then ' Si valeur de la cellule + pal < 16500 alors
            pal = Cells(i, 15).Value + pal ' pal = valeur cellule + pal
        Else ' Sinon
            Cells(i, 1).EntireRow.Insert ' Insérer colonne
'            i = i + 1
            pal = 0 ' Initialisation de pal
        End If ' Fin Si
        i = i + 1
    Loop 'Fin tant que


J'obtient :

Qté
4600
8000

4000
7200

5600
5100

7500

9300

10300
Messages postés
1561
Date d'inscription
jeudi 19 juillet 2007
Statut
Membre
Dernière intervention
30 avril 2019
275 >
Messages postés
375
Date d'inscription
mercredi 21 mai 2008
Statut
Membre
Dernière intervention
17 octobre 2008

envoi un site pour héberger le fichier je tenvoi la macro complémentaire et le fichier tu vera :'(
Messages postés
1561
Date d'inscription
jeudi 19 juillet 2007
Statut
Membre
Dernière intervention
30 avril 2019
275
parce que ca marche pas comme toi
Messages postés
1561
Date d'inscription
jeudi 19 juillet 2007
Statut
Membre
Dernière intervention
30 avril 2019
275
Messages postés
1561
Date d'inscription
jeudi 19 juillet 2007
Statut
Membre
Dernière intervention
30 avril 2019
275
help
Messages postés
375
Date d'inscription
mercredi 21 mai 2008
Statut
Membre
Dernière intervention
17 octobre 2008
122
La macro ne part pas "du bas" comme tu le penses, c'est la dernière cellule sélectionnée suite à l'execution de ton code précédent,

Elle boucle bien à partir de la cellule qui a comme référence la ligne i (donc 2 au départ) et la colonne 1 :

i = 2
Do While Cells(i,1).Value<>""

...

Le fait d'accéder directement à la référence de la cellule sans la sélectionner fait gagner en temps d'execution, mais en débuggage il est vrai qu'on est un peu perdu.

Ceci étant le problème venait d'ailleurs : quand le total était supérieur à 16500, la ligne s'ajoutait sans problème, mais si par malheur la cellule suivante dans la colonne O avait une valeur supérieure à 16500 également, les lignes s'inséraient à l'infini ...

Le code suivant devrait fonctionner :
    Pal = 0
    i = 2
    Do While Cells(i, 1).Value <> ""
        If Pal + Cells(i, 15).Value < 16500 Then
            Pal = Pal + Cells(i, 15).Value
        Else
            If Pal = 0 Then
                ' Si on venait d'insérer une ligne, alors insérer la suivante en ligne + 1
                Cells(i + 1, 15).EntireRow.Insert
                Pal = Cells(i, 15).Value
                i = i + 1
            Else
                Cells(i, 15).EntireRow.Insert
            End If
            ' Met le sous-total dans la cellule
            Cells(i, 15).Value = Pal
            Cells(i, 15).Font.Bold = True
            Pal = 0
        End If
        i = i + 1
    Loop
Messages postés
1561
Date d'inscription
jeudi 19 juillet 2007
Statut
Membre
Dernière intervention
30 avril 2019
275 >
Messages postés
375
Date d'inscription
mercredi 21 mai 2008
Statut
Membre
Dernière intervention
17 octobre 2008

:D marche pas plus ^^

Mais j'avais une couille déja dans mon code...

Ca reprend plus l'idée suivante :
[code]pal = 0
i = 2
Do While Cells(i, 1).Value <> "" 'Tant que cellule non vide faire
If (Cells(i + 1, 15).Value + Cells(i + 1, 15).Value + pal) < 16500 Then ' Si valeur de la cellule + pal < 16500 alors
pal = Cells(i, 15).Value + pal ' pal = valeur cellule + pal
Else ' Sinon
Cells(i, 1).EntireRow.Insert ' Insérer colonne
i = i + 1
pal = 0 ' Initialisation de pal
End If ' Fin
i = i + 1
Loop 'Fin tant que[/code]


Autrement ditpour tester la cellule suivante il faut bien additionner d'abord pal et la cellule sur laquelle on se trouve après ton code marche pas mieu :S
Messages postés
375
Date d'inscription
mercredi 21 mai 2008
Statut
Membre
Dernière intervention
17 octobre 2008
122 >
Messages postés
1561
Date d'inscription
jeudi 19 juillet 2007
Statut
Membre
Dernière intervention
30 avril 2019

Le code que je t'ai envoyé fonctionne pour moi, qu'est ce qui te gênait ?
Messages postés
1561
Date d'inscription
jeudi 19 juillet 2007
Statut
Membre
Dernière intervention
30 avril 2019
275 >
Messages postés
375
Date d'inscription
mercredi 21 mai 2008
Statut
Membre
Dernière intervention
17 octobre 2008

marche pas pour moi je sais pas pourquoi :(
Messages postés
1561
Date d'inscription
jeudi 19 juillet 2007
Statut
Membre
Dernière intervention
30 avril 2019
275 >
Messages postés
1561
Date d'inscription
jeudi 19 juillet 2007
Statut
Membre
Dernière intervention
30 avril 2019

C'est bon j'ai réussi en farfouillant...
Le code attendu et que j'ai enfin fini par trouver est :

    pal = 0
     i = 2
    Do While Cells(i, 1).Value <> "" 'Tant que cellule non vide faire
        
        If (Cells(i + 1, 15).Value + Cells(i, 15).Value + pal) <= 16500 Then ' Si valeur de la cellule + pal < 16500 alors
            pal = Cells(i, 15).Value + pal  ' pal = valeur cellule + pal
        Else ' Sinon
            i = i + 1
            Cells(i, 1).EntireRow.Insert ' Insérer colonne
            
            pal = 0 ' Initialisation de pal
        End If ' Fin
        i = i + 1
    Loop 'Fin tant que