[VBA] Problème de boucle ?

Résolu
Doudou95 Messages postés 1561 Date d'inscription   Statut Membre Dernière intervention   -  
Doudou95 Messages postés 1561 Date d'inscription   Statut Membre Dernière intervention   -
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

Réponse 1 / 14
Doudou95 Messages postés 1561 Date d'inscription   Statut Membre Dernière intervention   275
 
help :(
0
David
 
Salut doudou95

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

David
0
Réponse 2 / 14
Doudou95 Messages postés 1561 Date d'inscription   Statut Membre Dernière intervention   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
0
David
 
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
0
Réponse 3 / 14
Doudou95 Messages postés 1561 Date d'inscription   Statut Membre Dernière intervention   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
0
Réponse 4 / 14
Doudou95 Messages postés 1561 Date d'inscription   Statut Membre Dernière intervention   275
 
je pense que c'est clair où ne comprenez vous pas ma question?
0
onesdf Messages postés 375 Date d'inscription   Statut Membre Dernière intervention   120
 
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
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 14
Doudou95 Messages postés 1561 Date d'inscription   Statut Membre Dernière intervention   275
 
ca arrive en début de colonne puis erreur => Objet requis
0
onesdf Messages postés 375 Date d'inscription   Statut Membre Dernière intervention   120
 
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
0
Doudou95 Messages postés 1561 Date d'inscription   Statut Membre Dernière intervention   275 > onesdf Messages postés 375 Date d'inscription   Statut Membre Dernière intervention  
 
Comment définir pal? parce qu'il y a incompatibilité de type en erreur
0
onesdf Messages postés 375 Date d'inscription   Statut Membre Dernière intervention   120 > Doudou95 Messages postés 1561 Date d'inscription   Statut Membre Dernière intervention  
 
T'as quoi en colonne O ?

pal = Cells(i, 15).Value + pal
0
Réponse 6 / 14
Doudou95 Messages postés 1561 Date d'inscription   Statut Membre Dernière intervention   275
 
ben un entier vu que l'on l'additionne et que l'on vérifie qu'il est inférieur a 16500
0
onesdf Messages postés 375 Date d'inscription   Statut Membre Dernière intervention   120
 
T'as essayé le mode débuggage Pas à Pas avec un espion sur Cells(i, 15) ?
0
Réponse 7 / 14
Doudou95 Messages postés 1561 Date d'inscription   Statut Membre Dernière intervention   275
 
L'erreur se fait ici :
If (Cells(i, 15).Value + pal) < 16500 Then ' Si valeur de la cellule + pal < 16500 alors
0
onesdf Messages postés 375 Date d'inscription   Statut Membre Dernière intervention   120
 
Dès le premier passage ?

Qu'y a t'il et dans Cells(i,15).Value et dans pal au moment de l'erreur ?
0
Réponse 8 / 14
Doudou95 Messages postés 1561 Date d'inscription   Statut Membre Dernière intervention   275
 
tu trouves :S ?
0
Réponse 9 / 14
Doudou95 Messages postés 1561 Date d'inscription   Statut Membre Dernière intervention   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
0
onesdf Messages postés 375 Date d'inscription   Statut Membre Dernière intervention   120
 
Alors initialise ton i à 2
0
Réponse 10 / 14
Doudou95 Messages postés 1561 Date d'inscription   Statut Membre Dernière intervention   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
0
onesdf Messages postés 375 Date d'inscription   Statut Membre Dernière intervention   120
 
C'est pas Cells(1,15).value, mais Cells(i,15).value
0
onesdf Messages postés 375 Date d'inscription   Statut Membre Dernière intervention   120 > onesdf Messages postés 375 Date d'inscription   Statut Membre Dernière intervention  
 
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
0
Réponse 11 / 14
Doudou95 Messages postés 1561 Date d'inscription   Statut Membre Dernière intervention   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 :(
0
Réponse 12 / 14
Doudou95 Messages postés 1561 Date d'inscription   Statut Membre Dernière intervention   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
0
onesdf Messages postés 375 Date d'inscription   Statut Membre Dernière intervention   120
 
Enlèves le i = i + 1 après l'insertion de ligne
0
Doudou95 Messages postés 1561 Date d'inscription   Statut Membre Dernière intervention   275 > onesdf Messages postés 375 Date d'inscription   Statut Membre Dernière intervention  
 
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)
0
onesdf Messages postés 375 Date d'inscription   Statut Membre Dernière intervention   120 > Doudou95 Messages postés 1561 Date d'inscription   Statut Membre Dernière intervention  
 
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
0
Doudou95 Messages postés 1561 Date d'inscription   Statut Membre Dernière intervention   275 > onesdf Messages postés 375 Date d'inscription   Statut Membre Dernière intervention  
 
envoi un site pour héberger le fichier je tenvoi la macro complémentaire et le fichier tu vera :'(
0
Réponse 13 / 14
Doudou95 Messages postés 1561 Date d'inscription   Statut Membre Dernière intervention   275
 
parce que ca marche pas comme toi
0
Doudou95 Messages postés 1561 Date d'inscription   Statut Membre Dernière intervention   275
 
[url]http://uploading.com/files/61H0Z3WF/Inter_Macro.xls.html[/url]
[url]http://uploading.com/files/G42CBQ71/FormatCarton.xla.html[/url]

Tiens et test tu veras
0
Réponse 14 / 14
Doudou95 Messages postés 1561 Date d'inscription   Statut Membre Dernière intervention   275
 
help
0
onesdf Messages postés 375 Date d'inscription   Statut Membre Dernière intervention   120
 
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
0
Doudou95 Messages postés 1561 Date d'inscription   Statut Membre Dernière intervention   275 > onesdf Messages postés 375 Date d'inscription   Statut Membre Dernière intervention  
 
: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
0
onesdf Messages postés 375 Date d'inscription   Statut Membre Dernière intervention   120 > Doudou95 Messages postés 1561 Date d'inscription   Statut Membre Dernière intervention  
 
Le code que je t'ai envoyé fonctionne pour moi, qu'est ce qui te gênait ?
0
Doudou95 Messages postés 1561 Date d'inscription   Statut Membre Dernière intervention   275 > onesdf Messages postés 375 Date d'inscription   Statut Membre Dernière intervention  
 
marche pas pour moi je sais pas pourquoi :(
0
Doudou95 Messages postés 1561 Date d'inscription   Statut Membre Dernière intervention   275 > Doudou95 Messages postés 1561 Date d'inscription   Statut Membre Dernière intervention  
 
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
0

Discussions similaires

Erreur d'exécution 13 Incompatibilité de type
grace -
pijaku -

5 réponses
Mon pc s'allume et s'éteint en boucle
Jack -
Daniel -

16 réponses
"L'indice n'appartient à la sélection" + VBA
fleur.31 -
geosevda -

2 réponses
Mon ordinateur s'allume et s'eteint en boucle
mhmd_elmrni -
BiGaMeRz10 -

10 réponses
Erreur d'exécution '13': Incompatibilité de Type
SLM-BHY -
Heliotte -

8 réponses