[VBA] Problème de boucle

Résolu
saian-sugus Messages postés 35 Statut Membre -  
saian-sugus Messages postés 35 Statut Membre -
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. el_linwin Messages postés 517 Date d'inscription   Statut Membre 90
     
    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
  2. lermite222 Messages postés 9042 Statut Contributeur 1 199
     
    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
    1. saian-sugus Messages postés 35 Statut Membre
       
      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
      0
  3. saian-sugus Messages postés 35 Statut Membre
     
    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
  4. saian-sugus Messages postés 35 Statut Membre
     
    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
  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. lermite222 Messages postés 9042 Statut Contributeur 1 199
     
    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
    1. saian-sugus Messages postés 35 Statut Membre
       
      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.
      0
  7. saian-sugus Messages postés 35 Statut Membre
     
    Merci à tout ceux qui m'ont aidé, les problèmes sont résolus.

    Bonne soirée
    1
  8. el_linwin Messages postés 517 Date d'inscription   Statut Membre 90
     
    Bonsoir saian-sugus,

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

    Cordialement,
    el_linwin
    1
  9. saian-sugus Messages postés 35 Statut Membre
     
    Toute mes excuses je ne connaissai pas, je saurai pour la prochaine fois bonne soirée
    1
  10. el_linwin Messages postés 517 Date d'inscription   Statut Membre 90
     
    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
    0
  11. lermite222 Messages postés 9042 Statut Contributeur 1 199
     
    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+
    0
  12. anonyme
     
    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
    0
  13. Milou2211 Messages postés 43 Statut Membre 11
     
    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 ?
    0
  14. anonyme
     
    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
    0
  15. Frappe Misere Messages postés 2702 Statut Membre 568
     
    déclare ta variable pour qu elle soit publique.
    dans ta fonction, tu ajoutes juste linenom = linenom +1.
    0