XL 2013 Incrémentation de numéros d'anonymat pour des candidats à un examen plus barre de progression

D

Djibysadji

XLDnaute Nouveau
Bonsoir à tous!
Je cherche comment incrémenter des numéros d'anonymat pour des candidats à un examen en partant d'un numéro appelé début de série. Ce numéro peut être saisie dans une cellule ou texbox avec un bouton "incrémenter" qui déclenchera cette incrémentation. Nous aimerions aussi avoir une barre qui montrera la progression.
En même temps que l'incrémentation se fera, un numéro d'anonymat sera affecté à chaque candidat dans la colonne appelée ANO de la feuille "CANDIDATS"

djibysadji
 
Trier par date Trier par votes
AtTheOne

AtTheOne

XLDnaute Impliqué
Supporter XLD
Bonjour à toutes & à tous, bonjour @Djibysadji
Voilà ce que je te propose :
Une liste de candidats (Nom, Prénom, Date de Naissance "tout cela en aléatoire dans l'exemple") avec 25000 lignes

Une macro qui
  • Tri dans l'ordre Alphabétique la liste (+Date de naissance)
  • Demande le début de série
  • Remplit un tableau avec une liste séquentielle
  • Affecte les N° créés de manière aléatoire aux candidats
Le code se trouve dans le module Mdl_AtTheOne :
Enrichi (BBcode): 
Sub Tirage()
    Dim NbL As Long, Réponse, Début As Long, i As Long, j As Long, k As Long
    
    'Nombre de ligne du tableau "tb_ListeAlpha"
    NbL = Sh_Candidats.[tb_ListeAlpha].Rows.Count
    'Effacement des N° ANO précédents
    Sh_Candidats.[tb_ListeAlpha[ANO]].ClearContents
    
    'Tri dans l'ordre alphabétique + Date de naissance
    With Sh_Candidats.ListObjects("tb_ListeAlpha").Sort
        .SortFields.Clear
        .SortFields.Add Key:=Sh_Candidats.[tb_ListeAlpha[Nom]], SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Sh_Candidats.[tb_ListeAlpha[Prénom]], SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Sh_Candidats.[tb_ListeAlpha[Date de Naissance]], SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .Apply
    End With

    'Demande du N° de Début de série
    Réponse = Application.InputBox(Title:="Affectation des N° d'anonymat : Début de série", Prompt:="saisir un nombre entier :", Type:=1)
    If Réponse = False Then Exit Sub
    Début = CLng(Réponse)
    ReDim Temp(1 To NbL)
    ReDim TbRés(1 To NbL, 1 To 1)
    
    With UsF_Barre
        'Affichage de la barre d'avancement (non modal)
       .Show vbModeless
        'Remplir le tableau Temp avec la suite des N°
        For i = 0 To NbL - 1
            Temp(i + 1) = Début + i
        Next i
        'Remplir TbRés dans un ordre aléatoire
        For i = NbL To 1 Step -1
            k = Int((i) * Rnd + 1)
            TbRés(i, 1) = Temp(k)
            For j = k To i - 1
                Temp(j) = Temp(j + 1)
            Next j
            ReDim Preserve Temp(1 To i)
            'Mise à jour de la barre d'avancement
            Avancement = Int((NbL - i + 1) / NbL * UsF_Barre.Lbl_Fond.Width)
            .Lbl_Avancement.Width = Avancement
            .Caption = "Avancement " & Int(Avancement / 500 * 100) & "% - " & i
            DoEvents
        Next i
        'Coller les N° dans le tableau "tb_ListeAlpha"
        Sh_Candidats.[tb_ListeAlpha].Columns(1) = TbRés
        .Hide
    End With
    Unload UsF_Barre
    
End Sub

Amicalement
Alain
 

Pièces jointes

  • Incrémentation de numéros d'anonymat pour des candidats à un examen.xlsm
    911.4 KB · Affichages: 15
Dernière édition:
Vote positif 0 Vote négatif
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Djibysadji, AtTheOne,
Un essai en PJ, en un peu plus rapide.
L'astuce est de mettre en Numéro des nombres aléatoires, puis de trier sur cette colonne.
On supprime ces nombres, on les remplace par les N° dans l'ordre, et on retrie sur Nom Prénom.
A la fin on a une distribution aléatoire des attributions de nom.
J'ai supprimé la barre de progression car sur mon vieux PC ça met 0.3s.
VB: 
Sub TirageAuSort()
    Réponse = Application.InputBox(Title:="Affectation des N° d'anonymat : Début de série", Prompt:="Saisir un nombre entier :", Type:=1)
    If Réponse = False Then Exit Sub                                            'Demande du N° de Début de série ( Idem AtTheOne )
    Début = CLng(Réponse)
    T0 = Timer
    Application.ScreenUpdating = False
    Range("tb_ListeAlpha[Numéro]").ClearContents                                ' Efface colonne Numéro
    [A2].FormulaLocal = "=alea()"                                               ' Met des nombres aléatoires dans cette colonne
    With ActiveSheet.ListObjects("tb_ListeAlpha").Sort
        .SortFields.Clear                                                       ' Tri croissant sur cette colonne
        .SortFields.Add Key:=Range("tb_ListeAlpha[Numéro]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Header = xlYes
        .Apply
        Range("tb_ListeAlpha[Numéro]").ClearContents                            ' Efface colonne Numéro
        [A2].FormulaLocal = "=LIGNE()-2+" & Début                               ' Affecte les N°
        Range("tb_ListeAlpha[Numéro]") = Range("tb_ListeAlpha[Numéro]").Value   ' Supprime les formules, y met les valeurs
        .SortFields.Clear                                                       ' Nouveau tri Nom Prénom Date naissance
        .SortFields.Add Key:=Range("tb_ListeAlpha[Nom]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("tb_ListeAlpha[Prénom]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("tb_ListeAlpha[Date de Naissance]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Header = xlYes
        .Apply
    End With
    [H9] = Format(1000 * (Timer - T0), "0 ms")                                  ' Met le temps mesuré en H9 ( à supprimer )
End Sub
 

Pièces jointes

  • Incrémentation de numéros d'anonymat pour des candidats à un examen.xlsm
    987.8 KB · Affichages: 19
Vote positif 0 Vote négatif
D

Djibysadji

XLDnaute Nouveau
AtTheOne à dit:
Bonjour à toutes & à tous, bonjour @Djibysadji
Voilà ce que je te propose :
Une liste de candidats (Nom, Prénom, Date de Naissance "tout cela en aléatoire dans l'exemple") avec 25000 lignes

Une macro qui
  • Tri dans l'ordre Alphabétique la liste (+Date de naissance)
  • Demande le début de série
  • Remplit un tableau avec une liste séquentielle
  • Affecte les N° créés de manière aléatoire aux candidats
Le code se trouve dans le module Mdl_AtTheOne :
Enrichi (BBcode): 
Sub Tirage()
    Dim NbL As Long, Réponse, Début As Long, i As Long, j As Long, k As Long
   
    'Nombre de ligne du tableau "tb_ListeAlpha"
    NbL = Sh_Candidats.[tb_ListeAlpha].Rows.Count
    'Effacement des N° ANO précédents
    Sh_Candidats.[tb_ListeAlpha[ANO]].ClearContents
   
    'Tri dans l'ordre alphabétique + Date de naissance
    With Sh_Candidats.ListObjects("tb_ListeAlpha").Sort
        .SortFields.Clear
        .SortFields.Add Key:=Sh_Candidats.[tb_ListeAlpha[Nom]], SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Sh_Candidats.[tb_ListeAlpha[Prénom]], SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Sh_Candidats.[tb_ListeAlpha[Date de Naissance]], SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .Apply
    End With

    'Demande du N° de Début de série
    Réponse = Application.InputBox(Title:="Affectation des N° d'anonymat : Début de série", Prompt:="saisir un nombre entier :", Type:=1)
    If Réponse = False Then Exit Sub
    Début = CLng(Réponse)
    ReDim Temp(1 To NbL)
    ReDim TbRés(1 To NbL, 1 To 1)
   
    With UsF_Barre
        'Affichage de la barre d'avancement (non modal)
       .Show vbModeless
        'Remplir le tableau Temp avec la suite des N°
        For i = 0 To NbL - 1
            Temp(i + 1) = Début + i
        Next i
        'Remplir TbRés dans un ordre aléatoire
        For i = NbL To 1 Step -1
            k = Int((i) * Rnd + 1)
            TbRés(i, 1) = Temp(k)
            For j = k To i - 1
                Temp(j) = Temp(j + 1)
            Next j
            ReDim Preserve Temp(1 To i)
            'Mise à jour de la barre d'avancement
            Avancement = Int((NbL - i + 1) / NbL * UsF_Barre.Lbl_Fond.Width)
            .Lbl_Avancement.Width = Avancement
            .Caption = "Avancement " & Int(Avancement / 500 * 100) & "% - " & i
            DoEvents
        Next i
        'Coller les N° dans le tableau "tb_ListeAlpha"
        Sh_Candidats.[tb_ListeAlpha].Columns(1) = TbRés
        .Hide
    End With
    Unload UsF_Barre
   
End Sub

Amicalement
Alain
Cliquez pour agrandir...
sylvanu à dit:
Bonjour Djibysadji, AtTheOne,
Un essai en PJ, en un peu plus rapide.
L'astuce est de mettre en Numéro des nombres aléatoires, puis de trier sur cette colonne.
On supprime ces nombres, on les remplace par les N° dans l'ordre, et on retrie sur Nom Prénom.
A la fin on a une distribution aléatoire des attributions de nom.
J'ai supprimé la barre de progression car sur mon vieux PC ça met 0.3s.
VB: 
Sub TirageAuSort()
    Réponse = Application.InputBox(Title:="Affectation des N° d'anonymat : Début de série", Prompt:="Saisir un nombre entier :", Type:=1)
    If Réponse = False Then Exit Sub                                            'Demande du N° de Début de série ( Idem AtTheOne )
    Début = CLng(Réponse)
    T0 = Timer
    Application.ScreenUpdating = False
    Range("tb_ListeAlpha[Numéro]").ClearContents                                ' Efface colonne Numéro
    [A2].FormulaLocal = "=alea()"                                               ' Met des nombres aléatoires dans cette colonne
    With ActiveSheet.ListObjects("tb_ListeAlpha").Sort
        .SortFields.Clear                                                       ' Tri croissant sur cette colonne
        .SortFields.Add Key:=Range("tb_ListeAlpha[Numéro]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Header = xlYes
        .Apply
        Range("tb_ListeAlpha[Numéro]").ClearContents                            ' Efface colonne Numéro
        [A2].FormulaLocal = "=LIGNE()-2+" & Début                               ' Affecte les N°
        Range("tb_ListeAlpha[Numéro]") = Range("tb_ListeAlpha[Numéro]").Value   ' Supprime les formules, y met les valeurs
        .SortFields.Clear                                                       ' Nouveau tri Nom Prénom Date naissance
        .SortFields.Add Key:=Range("tb_ListeAlpha[Nom]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("tb_ListeAlpha[Prénom]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("tb_ListeAlpha[Date de Naissance]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Header = xlYes
        .Apply
    End With
    [H9] = Format(1000 * (Timer - T0), "0 ms")                                  ' Met le temps mesuré en H9 ( à supprimer )
End Sub
Cliquez pour agrandir...
Bonsoir!
Je vous présente mes excuses pour avoir mis beaucoup de temps avant de répondre. Pour des raisons indépendantes de ma volonté je suis restés quelques temps sans visiter le site.

Pour revenir au sujet, ce code marche parfaitement. Un joli travail! Cependant j'aimerais bien que les numéros incrémentés soient consécutifs(n+1). n étant le début de la série à générer et le numéro du premier candidats dans l'ordre alphabétique.

Cordialement
 
Vote positif 0 Vote négatif
D

Djibysadji

XLDnaute Nouveau
AtTheOne à dit:
Bonjour @Djibysadji
Pourrais tu dire si les solutions proposées te conviennent et éventuellement en marquer une comme solution ...
Merci d'avance
Amicalement
Alain
Cliquez pour agrandir...
Bonsoir!
Je vous présentes mes excuses pour avoir mis beaucoup de temps avant de réagir par rapport à vos propositions. Pour des raisons indépendantes de ma volonté je suis resté assez longtemps sans visiter le site.

Pour revenir au sujet, J'ai testé les deux propositions:
La première proposition marche parfaitement. Du joli travail! Cependant j'aimerais bien que les numéros soient incrémentés à n+1. n étant le début de la série et le numéro du premier candidats dans l'ordre alphabétique.
Pour la deuxième solution j'ai rencontré une erreur. Au click sur le bouton, la boite de dialogue affiche "Objet requis"

Cordialement
 
Vote positif 0 Vote négatif
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
Djibysadji à dit:
Cependant j'aimerais bien que les numéros incrémentés soient consécutifs(n+1). n étant le début de la série à générer et le numéro du premier candidats dans l'ordre alphabétique.
Cliquez pour agrandir...
Vous pourriez expliquer ?
Si vous appuyez sur le bouton, on vous demande à quel numéro on doit commencer, puis ensuite on fait n+1.
Djibysadji à dit:
en partant d'un numéro appelé début de série. Ce numéro peut être saisie dans une cellule ou texbox avec un bouton
Cliquez pour agrandir...
C'est exactement ce que vous demandez au post #1.
 
Vote positif 0 Vote négatif
AtTheOne

AtTheOne

XLDnaute Impliqué
Supporter XLD
Bonjour à toutes & à tous, bonjour @Djibysadji,
Pour les deux solutions, les n° attribués sont consécutifs mais répartis aléatoirement, sinon ce n'est plus vraiment des n° d'anonymat, car il suffit d'avoir la liste des candidats et le n° de départ pour retrouver le n° de n'importe quel candidat ...
Et pour faire cela plus besoin de macro,
Trier la liste dans l'ordre alphabétique,
Ecrire à côté du premier nom le premier n°, juste dessous incrémenter de 1
EDIT : "sélectionner ces deux cellules" et double cliquer sur le petit carré en bas à droite de la cellule, la liste de n° successifs se remplit toute seule...
Bon courage
Amicalement
Alain
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

A
  • Question
incrémentation des numéros à chaque impression
Réponses
1
Affichages
2 K
ya_v_ka
ya_v_ka
M
[REF] Wiki Page 8 de MichelXld
Réponses
0
Affichages
38 K
MichelXld
M

Membres actuellement en ligne

30 membres et 394 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 099
Messages
2 085 285
Membres
102 850
dernier inscrit
iqi