[VBA] Problème de boucle

Résolu
Bonjour,

Je suis nouveau en programmation et je créée un petit programme qui me permettra de distribuer des classes (un onglet par classe) selon une liste qui comprend nom (colonne a) prénom (colonne b) et classe (colonne c).

A chaque nouvelle classe, le programme me copiera l'onglet "modèle" et le renommera avec le nom de la classe, le nom se mettera alors en B10 de la feuille qui vient d'être crée, et le prénom en C10.

Voici mon code, il vous aidera certainement à mieux comprendre.

Option Explicit
Dim LineIndex As Long
Dim LineCalcul As Long

Sub APPLICATION()
Dim j As Long
Dim ClasseName As String

Worksheets("liste").Activate
Range("c2").Select
ActiveCell.CurrentRegion.Sort Key1:=Range("c2"), Order1:=xlAscending, Header:=xlYes
LineIndex = 1
LineCalcul = LineIndex + 1
For j = LineCalcul To 5000
ClasseName = Worksheets("liste").Cells(LineCalcul, 3)
If ClasseName = "" Then Exit For
PROCEDURE ClasseName
LineIndex = LineIndex + 1
DoEvents
Next j

End Sub

Sub PROCEDURE(ClasseName As String)
Dim j As Long
Dim NewClasse As String

OpenNewSheet ClasseName
For j = LineCalcul To 5000
NewClasse = Worksheets("liste").Cells(LineCalcul, 3)
If NewClasse = ClasseName Then
PROCEDURE2 ClasseName, j
Else
LineIndex = j + 1
Exit For
End If

DoEvents
Next j

End Sub

Sub OpenNewSheet(SheetName As Variant)

On Local Error Resume Next
Sheets("modèle").Copy Before:=Sheets(3)
ActiveSheet.Name = SheetName

End Sub

Sub PROCEDURE2(SheetName As Variant, LineCalcule As Long)
Dim nom As String
Dim Prenom As String
Dim LineNom As Long

LineNom = 10
nom = Worksheets("liste").Cells(LineCalcule, 1)
Prenom = Worksheets("liste").Cells(LineCalcule, 2)
Worksheets(SheetName).Cells(LineNom, 2) = nom
Worksheets(SheetName).Cells(LineNom, 3) = Prenom

End Sub

Mon problème se situe sur les deux dernière ligne, le LineNom est fixe, je ne sais pas comment y mettre une boucle afin de le faire avancer de 1 à chaque passage.

J'espère que vous pourrez m'aider, merci d'avance à ceux qui se pencheront sur mon problème :s
Configuration: Windows XP
Internet Explorer 7.0

14 réponses

  1. Bonjour saian-sugus,

    Lorsque vous dites: faire avancer de 1 à chaque passage, c'est-à-dire à chaque appel de la procédure PROCEDURE2 ?

    Si c'est le cas, il faut sortir la déclaration de la variable de la procédure, en faire une variable globale initialisée au début du programme, ou avant d'utiliser la procédure pour la première fois, et ajouter juste avant le "End Sub": LineNom=LineNom+1

    Cordialement,
    el_linwin
    1. Contributeur
      Bonjour,
      sait pas si j'ai bien saisi,

      Static LineNom As Long 
      
      If LineNom = 0 then
          LineNom =10
      Else
          LineNom = LineNom +1
      End if


      A+
      1. Bonjour saian-sugus,

        Mon précédent post ne semble pas s'afficher, aussi je rééecris.

        Le problème est que la variable LineNom est locale à la procédure PROCEDURE2.
        Il faut donc la déclarer en tant que variable globale, l'initialiser avant le premier appel à la procédure, puis ajouter avant le "End Sub": LineNom=LineNom+1.

        Cordialement,
        el_linwin
        1. For k "nouvelle variable"=1 to 500 (nombre de passages)
          Worksheets(SheetName).Cells(LineNom, 2) = nom
          Worksheets(SheetName).Cells(LineNom, 3) = Prenom
          LineNom = LineNom + 1

          un truc dans le genre, bon courage
          1. BOnjour,

            SI j'ai bien compris le pb, il faudrait que ta variable LINENOM soit globale, donc définie en dehors de tes procédures avec pour valeur initiale 10.

            Puis, dans PROCEDURE2, tu l'incrémentes linenom=linenom+1.

            Ca marche ?
            1. salut,

              For k (nouvelle variable) = 1 to ???(nombre de passages)
              Worksheets(SheetName).Cells(LineNom, 2) = nom
              Worksheets(SheetName).Cells(LineNom, 3) = Prenom
              LineNom = LineNom + 1

              un truc dans le genre,

              bon courage
              1. déclare ta variable pour qu elle soit publique.
                dans ta fonction, tu ajoutes juste linenom = linenom +1.
                1. Contributeur
                  Bonjour,
                  J'ai déjà répondu 2 fois à ta question mais avec les bug de CCM !!!!
                  J'ai pas bien saisi mais peutêtre ceci...
                  Static LineNom As Long 
                  If LineNom =0 then
                      LineNom =10
                  Else
                      LineNom =LineNom +1
                  End If


                  A+
                  1. Merci lermite222,

                    mais comme décrit ci-dessous, ta réponse fonctionne, mais un nouveau problème se lève :

                    Lorsque la classe change, une nouvelle feuille ne se copie pas mais au contraire, les noms continuent de se copier à la suite de la page copiée en premier
                2. Re-bonjour,

                  J'ai adapté la solution à el_linwin

                  mon code se présente comme ceci :

                  Option Explicit
                  Dim LineIndex As Long
                  Dim LineCalcul As Long
                  Dim LineNom As Long

                  Sub APPLICATION()
                  Dim j As Long
                  Dim ClasseName As String

                  LineNom = 10
                  Worksheets("liste").Activate
                  Range("c2").Select
                  ActiveCell.CurrentRegion.Sort Key1:=Range("c2"), Order1:=xlAscending, Header:=xlYes
                  LineIndex = 1
                  LineCalcul = LineIndex + 1
                  For j = LineCalcul To 5000
                  ClasseName = Worksheets("liste").Cells(LineCalcul, 3)
                  If ClasseName = "" Then Exit For
                  PROCEDURE ClasseName
                  LineIndex = LineIndex + 1
                  DoEvents
                  Next j

                  End Sub

                  Sub PROCEDURE(ClasseName As String)
                  Dim j As Long
                  Dim NewClasse As String

                  OpenNewSheet ClasseName
                  For j = LineCalcul To 5000
                  NewClasse = Worksheets("liste").Cells(LineCalcul, 3)
                  If NewClasse = ClasseName Then
                  LineNom = 10
                  PROCEDURE2 ClasseName, j
                  Else
                  LineIndex = j + 1
                  Exit For
                  End If

                  DoEvents
                  Next j

                  End Sub

                  Sub OpenNewSheet(SheetName As Variant)

                  On Local Error Resume Next
                  Sheets("modèle").Copy Before:=Sheets(3)
                  ActiveSheet.Name = SheetName

                  End Sub

                  Sub PROCEDURE2(SheetName As Variant, LineCalcule As Long)
                  Dim nom As String
                  Dim Prenom As String

                  nom = Worksheets("liste").Cells(LineCalcule, 1)
                  Prenom = Worksheets("liste").Cells(LineCalcule, 2)
                  Worksheets(SheetName).Cells(LineNom, 2) = nom
                  Worksheets(SheetName).Cells(LineNom, 3) = Prenom
                  LineNom = LineNom + 1
                  End Sub

                  J'ai déclaré la variable sous Option Explicit, et j'ai rentré le LineNom=10 tout au début, ne sachant ou le mettre.

                  Nouveau problème qui ne se fesait pas auparavant :

                  Lorsque je suis arrivé à la fin d'une classe, au lieu de changer "de manière de faire" le programme continue à me rajouter des noms dans la même page

                  Voici un apercu de ma feuille "liste" :

                  nom prenom classe année
                  V*** S*** 401_F 2008-2009
                  Z*** S*** 401_F 2008-2009
                  A*** M*** 501_D 2008-2009
                  A*** N*** 501_D 2008-2009
                  1. Je sais pas si j'ai été très clair dans ce que je souhaite faire, je reprend:

                    ma feuille liste se présente sous cette forme :

                    nom prenom classe année
                    V*** S*** 401_F 2008-2009
                    Z*** S*** 401_F 2008-2009
                    A*** M*** 501_D 2008-2009
                    A*** N*** 501_D 2008-2009

                    il existe une feuille modèle, que je copierai à chaque nouvelle classe.

                    Alors tout d'abord j'effectue un tri alphabétique de classe
                    Ensuite, je rencontre une classe inconnue alors je copie la feuille modèle et je la fait renommé en 401_F.
                    Je rentre en B10 et C10 les noms et prénoms
                    Je retourne sur ma liste et passe la ligne en dessous pour copier les donnée en B11 et C11 les noms prénoms si la classe est identique
                    ou je recommence le processus pour copier la table modèle et la renommé en 501_D, et coller les noms et prénoms correspondant en B10 et C10

                    et ainsi de suite.. et tout cela automatisé..

                    J'espère avoir été clair de ce que j'ai tenté de faire, merci de votre aide :s
                    1. Contributeur
                      Si c'est possible, met ton classeur sur Cjoint, ce serra plus efficasse.
                      https://www.cjoint.com/
                      et tu met le lien dans un poste suivant.
                      1. Non, malheureusement impossible.

                        Mais copie ces cellules dans uen fiche excel dans chaque onglet

                        liste (nom de l'onglet)
                        NOM PRENOM CLASSE_ETUDIANT ANNEE_ACADEMIQUE
                        Giroud André 111_A 2008-2009
                        Martin René 111_A 2008-2009
                        Zermatten Rudy 111_A 2008-2009
                        Zouper Marco 111_A 2008-2009
                        Falcon Michel 112_A 2008-2009
                        Wobi Markus 112_A 2008-2009
                        Grido Mario 112_A 2008-2009
                        Bornet Marin 112_A 2008-2009
                        Milu Tristan 112_A 2008-2009
                        Germanier Christian 112_B 2008-2009
                        Fumeau Tristan 122_B 2008-2009

                        et concernant l'onglet modèle, il suffit de savoir que le programme doit commencer à coller en B10 et C10.

                        Ensuite le code

                        Option Explicit
                        Dim LineIndex As Long
                        Dim LineCalcul As Long

                        Sub APPLICATION()
                        Dim j As Long
                        Dim ClasseName As String

                        Worksheets("liste").Activate
                        Range("c2").Select
                        ActiveCell.CurrentRegion.Sort Key1:=Range("c2"), Order1:=xlAscending, Header:=xlYes
                        LineIndex = 1
                        LineCalcul = LineIndex + 1
                        For j = LineCalcul To 5000
                        ClasseName = Worksheets("liste").Cells(LineCalcul, 3)
                        If ClasseName = "" Then Exit For
                        PROCEDURE ClasseName
                        LineIndex = LineIndex + 1
                        DoEvents
                        Next j

                        End Sub

                        Sub PROCEDURE(ClasseName As String)
                        Dim j As Long
                        Dim NewClasse As String

                        OpenNewSheet ClasseName
                        For j = LineCalcul To 5000
                        NewClasse = Worksheets("liste").Cells(LineCalcul, 3)
                        If NewClasse = ClasseName Then
                        PROCEDURE2 ClasseName, j
                        Else
                        LineIndex = j + 1
                        Exit For
                        End If

                        DoEvents
                        Next j

                        End Sub

                        Sub OpenNewSheet(SheetName As Variant)

                        On Local Error Resume Next
                        Sheets("modèle").Copy Before:=Sheets(3)
                        ActiveSheet.Name = SheetName

                        End Sub

                        Sub PROCEDURE2(SheetName As Variant, LineCalcule As Long)
                        Dim nom As String
                        Dim Prenom As String
                        Static LineNom As Long

                        If LineNom = 0 Then
                        LineNom = 10
                        Else
                        LineNom = LineNom + 1
                        End If
                        nom = Worksheets("liste").Cells(LineCalcule, 1)
                        Prenom = Worksheets("liste").Cells(LineCalcule, 2)
                        Worksheets(SheetName).Cells(LineNom, 2) = nom
                        Worksheets(SheetName).Cells(LineNom, 3) = Prenom
                        End Sub

                        Le problème semble être que je lui demande si NewClasse=ClasseName alors y rajoute à la suite.
                        Hors la définition des deux champs est la même (voir souligné).
                        Je suis entrain de réfléchir au problème, si vous avez une idée merci de votre aide.
                    2. Merci à tout ceux qui m'ont aidé, les problèmes sont résolus.

                      Bonne soirée
                      1. Bonsoir saian-sugus,

                        N'hésitez pas à faire passer le statut de la discussion en "Résolu". =)

                        Cordialement,
                        el_linwin
                        1. Toute mes excuses je ne connaissai pas, je saurai pour la prochaine fois bonne soirée