[VBA] Problème de boucle ?

Résolu
Doudou95 -  
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
Configuration: Windows XP
Firefox 2.0.0.14

14 réponses

Résumé de la discussion

Le fil porte sur une macro Excel VBA qui parcourt la colonne Qte et additionne les valeurs jusqu'à ce que la somme atteigne 16500, puis insère une ligne avant celle qui dépasserait le seuil. Des solutions recommandent d'évaluer If (valeur_colonne + pal) < 16500 puis d'actualiser pal, et d'insérer une ligne et de réinitialiser pal lorsque le seuil serait franchi. D'autres échanges insistent sur le fait de tester jusqu'à la dernière cellule non vide et d'utiliser la valeur de la colonne O (colonne 15) plutôt que des indices fixes. Une remarque clé précise que la mise à jour correcte des indices et l'initialisation de pal évitent l'erreur fréquemment rencontrée.

Bobot (l’IA à votre service)
  1. Doudou95 Auteur
    help
    1. onesdf
      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
    2. Doudou95 Auteur
      @onesdf: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
    3. onesdf
      @Doudou95Le code que je t'ai envoyé fonctionne pour moi, qu'est ce qui te gênait ?
    4. Doudou95 Auteur
      @onesdfmarche pas pour moi je sais pas pourquoi :(
    5. Doudou95 Auteur
      @Doudou95C'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
  3.  Doudou95 Auteur
    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
    1. onesdf
      Enlèves le i = i + 1 après l'insertion de ligne
    2. Doudou95 Auteur
      @onesdfca 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)
    3. onesdf
      @Doudou95En 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
    4. Doudou95 Auteur
      @onesdfenvoi un site pour héberger le fichier je tenvoi la macro complémentaire et le fichier tu vera :'(
  4. Doudou95 Auteur
    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 :(
    2. Doudou95 Auteur
      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
      1. onesdf
        C'est pas Cells(1,15).value, mais Cells(i,15).value
      2. onesdf
        @onesdfRé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
    3. Doudou95 Auteur
      Cells(i;15) = Qté ca a pris la ligne 1 faut que ca commence à la seconde !) et pal c'est bon c'est 0
      1. onesdf
        Alors initialise ton i à 2
    5. Doudou95 Auteur
      L'erreur se fait ici :
      If (Cells(i, 15).Value + pal) < 16500 Then ' Si valeur de la cellule + pal < 16500 alors
      1. onesdf
        Dès le premier passage ?

        Qu'y a t'il et dans Cells(i,15).Value et dans pal au moment de l'erreur ?
    6. Doudou95 Auteur
      ben un entier vu que l'on l'additionne et que l'on vérifie qu'il est inférieur a 16500
      1. onesdf
        T'as essayé le mode débuggage Pas à Pas avec un espion sur Cells(i, 15) ?
    7. Doudou95 Auteur
      ca arrive en début de colonne puis erreur => Objet requis
      1. onesdf
        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
      2. Doudou95 Auteur
        @onesdfComment définir pal? parce qu'il y a incompatibilité de type en erreur
      3. onesdf
        @Doudou95T'as quoi en colonne O ?

        pal = Cells(i, 15).Value + pal
    8. Doudou95 Auteur
      je pense que c'est clair où ne comprenez vous pas ma question?
      1. onesdf
        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
    9. Doudou95 Auteur
      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
      1. Doudou95 Auteur
        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
        1. 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
      2. Doudou95 Auteur
        help :(
        1. David
          Salut doudou95

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

          David

      Discussions similaires

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

      16 réponses
      Ma Livebox redémarre en boucle !
      Utilisateur anonyme

      5 réponses
      Mon ordinateur s'allume et s'eteint en boucle
      mhmd_elmrni

      10 réponses
      Mon PC s'allume puis s'éteint tout seul. Que faire ?
      La gouille

      28 réponses
      VBA excel : résoudre problème de capacité.
      Juan Pedro

      9 réponses