Macro Excel combinaison de chiffres aléatoire

cheribibi33

XLDnaute Nouveau
Bonjour,

Je recherche une macro excel qui permet de créer une combinaison de chiffres aléatoire.

J'ai 90 chiffres (de 1 à 90), il me faudrait des combinaisons de 3 chiffres différent dans une combinaison

Il faudrait générer 12000 combinaisons

exemple :
cellules D1:10 E1:20 F1:48
cellules D2:45 E2:32 F2:56
cellules D3:15 E3:10 F3:90

Sous excel 2010

Merci
 

PMO2

XLDnaute Accro
Re : Macro Excel combinaison de chiffres aléatoire

Bonjour,

Une piste avec le code suivant
Code:
'### Constante à adapter ###
Const NB_COMBINAISONS As Long = 12000
'###########################

Sub aa()
Dim S As Worksheet
Dim g&
Dim i&
Dim bool As Boolean
Dim Combi&(1 To 3)
Dim T(1 To NB_COMBINAISONS, 1 To 3)
For i& = 1 To NB_COMBINAISONS
  Randomize Timer
  If bool Then
    i& = i& - 1
    bool = False
  End If
  For g& = 1 To 3
    Combi&(g&) = Int((90 * Rnd) + 1)
  Next g&
  If Combi&(3) = Combi&(2) Or Combi&(2) = Combi&(1) Or Combi&(3) = Combi&(1) Then
    bool = True
  Else
    For g& = 1 To 3
      T(i&, g&) = Combi&(g&)
    Next g&
  End If
Next i&
'---
Set S = Sheets.Add
S.Range("a1:c" & NB_COMBINAISONS & "") = T
End Sub

Le résultat s'affiche dans une nouvelle feuille.
 

cheribibi33

XLDnaute Nouveau
Re : Macro Excel combinaison de chiffres aléatoire

Bonjour,

je reviens sur mon poste car après avoir tester votre macro, je me suis aperçu que les combinaisons recommencé à l'identique au bout de certaines lignes exemple :
ligne 1 : 25 76 32
ligne 2 : 42 71 73
ligne 3 : 24 27 56
ligne 4 : 70 71 33

ligne 247 : 25 76 32
ligne 248 : 42 71 73
ligne 249 : 24 27 56
ligne 250 : 70 71 33

ligne 493 : 25 76 32
ligne 494 : 42 71 73
ligne 495 : 24 27 56
ligne 496 : 70 71 33

etc...

Merci
 

job75

XLDnaute Barbatruc
Re : Macro Excel combinaison de chiffres aléatoire

Bonsoir cheribibi33, salut Patrick,

Mieux vaut tard que jamais n'est-ce pas ?

La macro dans le fichier joint :

- crée un tableau de toutes les combinaisons possibles => 117480 lignes, 3 colonnes

- fait 12000 tirages aléatoires des lignes de ce tableau.

Code:
Sub TirageCombinaisons()
Dim n As Byte, nc&, Ntirages&, combi() As Byte
Dim i As Byte, j As Byte, k As Byte
Dim lig&, liste(), d As Object, dc&
n = 90
nc = Application.Combin(n, 3) '117480 combinaisons
Ntirages = 12000 'nombre de tirages
'---Création de la liste des combinaisons---
ReDim combi(1 To nc, 1 To 3)
For i = 1 To n - 2
  For j = i + 1 To n - 1
    For k = j + 1 To n
      lig = lig + 1
      combi(lig, 1) = i
      combi(lig, 2) = j
      combi(lig, 3) = k
    Next
  Next
Next
'---tirages aléatoires---
ReDim liste(1 To Ntirages, 1 To 3)
Set d = CreateObject("Scripting.Dictionary")
Randomize
While d.Count < Ntirages
  lig = 1 + Int(nc * Rnd)
  If Not d.exists(lig) Then
    d(lig) = ""
    dc = d.Count
    liste(dc, 1) = combi(lig, 1)
    liste(dc, 2) = combi(lig, 2)
    liste(dc, 3) = combi(lig, 3)
  End If
Wend
'---édition---
[D2:F2].Resize(Ntirages) = liste
End Sub
A+
 

Pièces jointes

  • Tirages combinaisons(1).xls
    43 KB · Affichages: 173
Dernière édition:

job75

XLDnaute Barbatruc
Re : Macro Excel combinaison de chiffres aléatoire

Bonjour cheribibi33, le forum,

Si maintenant on veut traiter les arrangements (90 x 89 x 88 = 704880) :

Code:
Sub TirageArrangements()
Dim n&, na&, Ntirages&, arrang() As Byte
Dim i As Byte, j As Byte, k As Byte
Dim lig&, liste(), d As Object, dc&
n = 90
na = n * (n - 1) * (n - 2) '704880 arrangements
Ntirages = 12000 'nombre de tirages
'---Création de la liste des arrangements---
ReDim arrang(1 To na, 1 To 3)
For i = 1 To n
  For j = 1 To n
    If j <> i Then
      For k = 1 To n
        If k <> i And k <> j Then
          lig = lig + 1
          arrang(lig, 1) = i
          arrang(lig, 2) = j
          arrang(lig, 3) = k
        End If
      Next
    End If
  Next
Next
'---tirages aléatoires---
ReDim liste(1 To Ntirages, 1 To 3)
Set d = CreateObject("Scripting.Dictionary")
Randomize
While d.Count < Ntirages
  lig = 1 + Int(na * Rnd)
  If Not d.exists(lig) Then
    d(lig) = ""
    dc = d.Count
    liste(dc, 1) = arrang(lig, 1)
    liste(dc, 2) = arrang(lig, 2)
    liste(dc, 3) = arrang(lig, 3)
  End If
Wend
'---édition---
[D2:F2].Resize(Ntirages) = liste
End Sub
Rappelons que pour les arrangements l'ordre des items importe, pour les combinaisons il n'importe pas.

Fichier joint.

A+
 

Pièces jointes

  • Tirages arrangements(1).xls
    44 KB · Affichages: 108

Discussions similaires

Réponses
1
Affichages
1 K

Statistiques des forums

Discussions
312 239
Messages
2 086 508
Membres
103 237
dernier inscrit
smbt-excel