Private Sub CommandButton1_Click() Dim montab(3) As String, i As Integer, nb As Integer, oyu As Integer For i = 3 To 6 montab(i - 3) = Sheets("feuil1").Range("C" & i) Next Randomize Timer nb = UBound(montab) For i = 0 To nb \ 2 ou = Int(((nb - i) * Rnd)) temp = montab(ou) montab(ou) = montab(nb - i) montab(nb - i) = temp Next madistrib = Array("A3", "A12", "A21", "A32") For i = 0 To nb Sheets("feuil2").Range(madistrib(i)).Value = montab(i) Next End Sub
Dim montab(3) As String, i As Integer, nb As Integer, ou As Integer, nombre_a_tirer As Integer nombre_a_tirer = 2 ' <====== ben...tu définis ici le nombre à tirer
For i = 0 To nombre_a_tirer - 1 Sheets("feuil2").Range(madistrib(i)).Value = montab(i) Next
Sub GenererTetesSerie() Top = 4 Dim Adr1 As String, Adr As String Dim flag() As Integer ReDim flag(Top) For i = 1 To Top flag(i) = 1 Next i 'nom de la feuille où se trouve les données NomFeuilleListe = "Participants" 'A adapter 'Plage liste de tous les noms Adr = "C3:C6" 'A adapter 'Plage où sera copiée la sélection retenue Adr1 = "A3,A12,A21,A32" 'A adapter NomFeuilleRes = "Poules" With Worksheets(NomFeuilleListe) Set Rg = .Range(Adr) End With With Worksheets(NomFeuilleRes) Set Rg1 = .Range(Adr1) End With Application.ScreenUpdating = False On Error Resume Next For Each Cell In Rg1 Do Nb = Rg.Rows.Count R = Int((Nb * Rnd) + 1) If flag(R) = 1 Then flag(R) = 0 Else While flag(R) = 0 sortie = Int(Rnd() * Top) + 1 Wend flag(R) = 0 End If Cell.Value = Rg(R) Loop Until Cell <> "" Next Set Rg Nothing: Set Rg1 Nothing End Sub
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question