[VBA] Problème de boucle ?
Résolu
Doudou95
Messages postés
1897
Date d'inscription
Statut
Membre
Dernière intervention
-
Doudou95 Messages postés 1897 Date d'inscription Statut Membre Dernière intervention -
Doudou95 Messages postés 1897 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
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
Configuration: Windows XP Firefox 2.0.0.14
14 réponses
-
-
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 -
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 -
je pense que c'est clair où ne comprenez vous pas ma question?
-
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
-
-
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question -
ca arrive en début de colonne puis erreur => Objet requis
-
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
-
-
ben un entier vu que l'on l'additionne et que l'on vérifie qu'il est inférieur a 16500
-
L'erreur se fait ici :
If (Cells(i, 15).Value + pal) < 16500 Then ' Si valeur de la cellule + pal < 16500 alors -
tu trouves :S ?
-
Cells(i;15) = Qté ca a pris la ligne 1 faut que ca commence à la seconde !) et pal c'est bon c'est 0
-
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-
- 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
-
-
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 :(
-
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-
- 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
-
-
parce que ca marche pas comme toi
-
[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
-
-
-
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- :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 - 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
-
