XL 2019 grille aléatoire sans doublon

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Gaborn

XLDnaute Nouveau
je crée une grille aléatoire sans doublon
j'arrive avec les doublons mais sans c'est le problème
voici mon script d'origine
Sub main()
For ligne = 2 To 51
For colonne = 2 To 36
If Cells(ligne, colonne) <> 0 Then Cells(ligne, colonne) = 1727
Next colonne
Next ligne
For ligne = 2 To 51
For colonne = 2 To 36
Valeur = Int((1726 * Rnd) + 1)
If Cells(ligne, colonne) <> 0 Then Cells(ligne, colonne) = Valeur
Next colonne
Next ligne
End Sub
Merci de votre aide
 
Bonjour.
Un exemple de code utilisant le module de classe ListeAléat :
VB:
Sub Main()
   Dim LAt As New ListeAléat, T(), A&, L&, C&, P&
   T = Cells(2, 2).Resize(50, 35).Value
   Randomize
   LAt.Init 1726
   For L = 1 To 50: For C = 1 To 35
      If T(L, C) <> 0 Then P = P + 1: A = LAt.Aléat(P) Else A = 0
      If A = 0 Then T(L, C) = Empty Else T(L, C) = A
      Next C, L
   Cells(2, 2).Resize(50, 35).Value = T
   End Sub
Un autre code (ça dépend de ce que vous aviez voulu faire) :
VB:
Sub Main()
   Dim LAt As New ListeAléat, T(), L&, C&, P&, A&
   ReDim T(1 To 50, 1 To 35)
   Randomize
   LAt.Init 50 * 35
   For L = 1 To 50: For C = 1 To 35
      P = P + 1: A = LAt.Aléat(P): If A > 1726 Then A = 0
      If A = 0 Then T(L, C) = Empty Else T(L, C) = A
      Next C, L
   Cells(2, 2).Resize(50, 35).Value = T
   End Sub
Un autre encore :
Code:
Sub Main()
   Dim LAt As New ListeAléat, T(), L&, C&, P&, A&
   ReDim T(1 To 50, 1 To 35)
   Randomize
   LAt.Init 1726
   For L = 1 To 50: For C = 1 To 35
      P = P + 1: A = LAt.Aléat(P)
      If A = 0 Then Exit For
      T(L, C) = A
      Next C, L
   Cells(2, 2).Resize(50, 35).Value = T
   End Sub
 

Pièces jointes

Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
8
Affichages
467
Réponses
8
Affichages
233
Réponses
4
Affichages
177
Réponses
3
Affichages
193
Réponses
5
Affichages
232
Réponses
10
Affichages
281
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
479
Retour