Fête d'ami - VBA dans Excel 2007

Fête d'ami - VBA dans Excel 2007 - VB/VBA/VBS - Programmation

Marsh Posté le 20-03-2012 à 02:26:13    

Bonjour,
 
Je voudrais faire un petit programme excel très simple
 
Dans les cellules A1 à A30 ou A40 (environ) je veux inscrire tous les amis invités de mon fils.
 
Ensuite, je veux faire un tirage de 5 cadeaux. Les amis ne peuvent pas gagner plus d'une fois.
 
J'ai fait une fonction qui me permet de savoir le nombre d'enfants ... c'est déjà un bon début  
 
Maintenant je voudrais bâtir une liste de tous les noms en mémoire et faire un random pour avoir 1 gagnant, enlever ce gagnant de la liste, refaire un random, enlever ce gagnant, etc ... le tout 5 fois.
 
Merci pour votre aide

Reply

Marsh Posté le 20-03-2012 à 02:26:13   

Reply

Marsh Posté le 21-03-2012 à 05:40:44    

Alors voici ce que je voudrais faire exactement :
 
Mon petit programme est plus compliqué que je l'avais imaginé ...
 
Le tirage au sort soit se faire en x étapes, autant d'étape qu'il y a de cadeaux.
 
Le premier résultat doit écrire BRAVO vis à vis la ligne du participant ayant remporté le prix et vis à vis la colonne "Cadeau 1".
Le deuxième résultat doit écrire BRAVO vis à vis la ligne du participant ayant remporté le prix et vis à vis la colonne "Cadeau 2".
Le troisième résultat ........ vis à vis la colonne "Cadeau 3"
Le quatrième résultat ......... vis à vis la colonne "Cadeau 4"
etc ... jusqu'au 6e cadeau.
 
Voici mon code
 
Sub TestY()
 
    Dim NombreCadeau As Integer
    NombreCadeau = Range("A1" ).Value
    Feuil2.Range("B2", "G14" ).ClearContents
    GenereSerieAleatoireSansDoublons NombreCadeau, Range("B2" )
End Sub  
 
Sub GenereSerieAleatoireSansDoublons(NbValeurs As Integer, Cell As Range)
    Dim Tableau() As Integer, TabNumLignes() As Integer
    Dim i As Integer, k As Integer, col As Integer
    Dim LastRow As Integer
 
    ReDim Tableau(NbValeurs)
    ReDim TabNumLignes(NbValeurs)
 
    col = 2
 
    LastRow = Feuil2.Range("A" & Rows.Count).End(xlUp).Row
    LastRow = LastRow - 1 'ENLEVER 1 valeur puisque A1 ne compte pas pour un participant ... pas très esthétique comme programmation désolé
 
    For i = 1 To NbValeurs
        TabNumLignes(i) = i
        Tableau(i) = i
    Next
 
    'Initialise le générateur de nombres aléatoires
    Randomize
 
    For i = NbValeurs To 1 Step -1
        k = Int((i * Rnd) + 1)
        Cells(k + 1, col) = Tableau(TabNumLignes(k))
        'Cells(k + 1, col) = "BRAVO"
        col = col + 1
        TabNumLignes(k) = TabNumLignes(i)
    Next
 
End Sub
 
Je ne suis vraiment pas loin ... le problème est que les résultats ne s'affiche pas dans les bonnes lignes ...
 
 
Bon courage au pro du VBA ... moi j'ai la tête qui devient folle  

Reply

Marsh Posté le 22-03-2012 à 21:04:11    

Tu n'utilises pas ton LastRow :o

 

sinon l'histoire de retirer un élément ca me fait penser direct à une collection qui a une méthode Remove:

 
Citation :

Sub tirage()

 

Dim i As Integer, nbCadeaux As Integer, num_gagnant As Integer
Dim collec As Collection

 

nbCadeaux = 5

 

With ThisWorkbook.Worksheets("Tirage" )
    Set collec = New Collection
    For i = 1 To .Cells(1, 1).End(xlDown).Row
        collec.Add Item:=i, Key:=CStr(.Cells(i, 1).Value)
    Next i
   
    .Columns(2).ClearContents
    Randomize
   
    For i = 1 To nbCadeaux
        num_gagnant = Int((Rnd * collec.Count) + 1)
        .Cells(collec.Item(num_gagnant), 2).Value = "Cadeau " & CStr(i) 'get winner line from item i
        collec.Remove (.Cells(collec.Item(num_gagnant), 1).Value) 'remove winner from collec with name as key
    Next i
    Set collec = Nothing
End With

 

End Sub



Message édité par tarteflambee le 22-03-2012 à 21:05:56
Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed