1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113
|
Sub MNbAleatoire()
' Déclaration de variables
Dim Cellule As Range
Dim NbLignes As Integer, NbLignesResult As Integer, NbAleatoires As Integer
Dim Tableau()
Dim i As Integer, j As Integer, k As Integer, nbLignesDestination As Integer
Dim FDestination As Worksheet 'FeuilleDestination
Dim FSource As Worksheet 'FeuilleSource
Dim Message As String
Dim nbVoulu As Integer
Dim nbColonnes As Integer
Dim DerColonneFDestination As Long
Dim DerColonneFSource As Long
Dim DerColFSource As Long
DEBUT_GENERATION:
Message = ""
nbColonnes = 0
DerColonneFDestination = 0
DerColonneFSource = 0
DerColFSource = 0
Set FSource = Nothing
Set FDestination = Nothing
Set Cellule = Nothing
Set FSource = Worksheets("Feuil1")
Set FDestination = Worksheets("Feuil2")
'Indique le numéro de la dernière ligne non vide dans la colonne A
NbLignes = FSource.Range("A65536").End(xlUp).Row
'Dernière colonne de la FeuilleDestination
DerColonneFDestination = FDestination.Cells(1, Rows(1).Cells.Count).End(xlToLeft).Column
'Dernière colonne de la FeuilleSource
DerColonneFSource = FSource.Cells(1, Rows(1).Cells.Count).End(xlToLeft).Column
'Permet à l'utilisateur de saisir le nombre de valeurs aléatoires voulus.
Message = InputBox("Entrez le nombre de valeurs aléatoires voulues :", "Génération de nombres aléatoires", "10")
'La ligne suivante arrête la procédure si l'utilisateur 'clique sur "Annuler"
If Message = "" Then Exit Sub
'La ligne suivante place la valeur saisie dans la cellule 'A1 de la feuille active
nbVoulu = Int(Message)
k = 0
ReDim Tableau(NbLignes)
'Remplit le tableau qui va servir au tirage aléatoire
'en utilisant les données de la colonne A.
For Each Cellule In Range("A1:A" & NbLignes)
Tableau(Cellule.Row - 1) = Cellule
Next Cellule
'Permute les données de façon aléatoire.
For i = 1 To nbVoulu
Randomize 'Initialise le générateur de nombre aléatoire
'Permet de générer un nombre aléatoire (valeur entière) compris entre 0 et 1.
'Le nombre aléatoire est spécifié par l'utilisateur.
NbAleatoires = Int(Rnd * NbLignes) + 1
'Insére dans la cellule la donnée du tableau correspondant à cette valeur aléatoire
FDestination.Cells((i + 1), 1) = Tableau(NbAleatoires - 1)
'Nb colonnes dans la FeuilleSource
nbColonnes = FSource.UsedRange.Columns.Count
'Copier les lignes rattachées aux valeurs aléatoires trouvées
'Pour chaque colonne de la FeuilleSource, copier les valeurs associées
' aux différentes valeurs aléatoires dans la FeuilleDestination.
For j = 1 To nbColonnes
FDestination.Cells((i + 1), j) = FSource.Cells(NbAleatoires, j).Value
Next j
Next i
'Copier les entêtes de ma FeuilleSource dans ma FeuilleDestination
'Pour chaque colonne à la première ligne de la FeuilleSource,
'copier les entêtes à la première ligne dans la FeuilleDestination
For k = 1 To DerColonneFSource
FDestination.Cells(1, k) = FSource.Cells(1, k).Value
Next k
'-- Afficher un message de succès lorsque le remplissage est complété
'-- Demander à l'utilisateur s'il désire appliquer le remplissage sur une autre colonne
If (MsgBox(prompt:=". : : Génération de valeurs aléatoires complétée: : ." & vbCrLf & vbCrLf & "Les valeurs aléatoires trouvées " & FSource.Name & " sont maintenant insérées dans la feuille « " & FDestination.Name & " »." & vbCrLf & vbCrLf & "Désirez-vous appliquer la génération de nouvelles valeurs aléatoires?", Buttons:=vbYesNo, Title:="Générer les valeurs aléatoires") = vbYes) Then
' Effacer les valeurs de la feuille "Feuil2"
Dim DerniereLigne
Dim r
DerniereLigne = FDestination.ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False
For r = DerniereLigne To 1 Step -1
If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r
GoTo DEBUT_GENERATION
Else
GoTo FIN_GENERATION
End If
FIN_GENERATION:
End Sub |
Partager