Microsoft 365 Nombre aléatoire ordre croissant dans une zone sélectionnée

wiwi520

XLDnaute Nouveau
Bonjour,

Je cherche un code en VBA pour générer des nombres dans un ordre croissant sur une colonne (A par exemple) de manière aléatoire et que cette macro s'applique sur une sélection que je ferais manuellement. En d'autres mots je veux que cette macro ne s'applique que sur les cellules que je sélectionne.
Par exemple:
Si je sélectionne les cellules (A1:A10) et j'active la commande macro, seules ces cellules afficheront des nombres croissants de manière aléatoire. Je pourrais aussi sélectionner les cellules (A3:A7), ou (A8 : A25) pour avoir le même résultat.

Alors j'ai jamais fait des macros.

Merci pour votre aide précieuse.
 

Dranreb

XLDnaute Barbatruc
Bonsoir.
Information. Mon objet ListeAléat a une méthode PartieClassée pour sortir ça.
Mais je n'en ai jamais eu besoin.
VB:
Sub Test()
   Dim LAt As New ListeAléat
   LAt.Init 35
   [A1].Resize(10).Value = WorksheetFunction.Transpose(LAt.PartieClassée(10))
   End Sub
Nécessite le module de classe ListeAléat du classeur joint.
 

Pièces jointes

  • ListeAléat.xlsm
    347.3 KB · Affichages: 6

job75

XLDnaute Barbatruc
Bonsoir à tous,

Avec la méthode suggérée par jmfmarques :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim nmax&, n#, i&, nn&, a&
nmax = 35 'modifiable mais il est conseillé de ne pas dépasser 10000...
n = Target.CountLarge
If Target.Columns.Count > 1 Or nmax > Rows.Count - Target.Row + 1 Or n > nmax Or n = 1 Then Exit Sub
Application.ScreenUpdating = False
If n < nmax Then Target(2).Resize(nmax - n).Insert xlDown 'insère des cellules
Target(1) = 1: Target.DataSeries 'numérotation en ordre croissant
'Target(1) = nmax: Target.DataSeries Step:=-1 'numérotation en ordre décroissant
For i = 1 To nmax - n
    nn = nmax - i + 1 'hauteur de la plage
    a = Application.RandBetween(1, nn) 'numéro de ligne aléatoire
    Target(a).Delete xlUp 'supprime cette ligne
Next
End Sub
Edit : CountLarge

Bonne nuit.
 

Pièces jointes

  • Alea(1).xlsm
    17 KB · Affichages: 3
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour le fil, le forum,

Avec nmax = 10000 la macro précédente s'exécute chez moi en 20 secondes sur une petite sélection.

Dans les mêmes conditions cette macro s'exécute en 0,8 seconde :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim nmax&, n#, tablo, i&, a&
nmax = 35 'modifiable mais il est conseillé de ne pas dépasser 100000...
n = Target.CountLarge
If Target.Columns.Count > 1 Or nmax > Rows.Count - Target.Row + 1 Or n > nmax Or n = 1 Then Exit Sub
Application.ScreenUpdating = False
If n < nmax Then Target(2).Resize(nmax - n).Insert xlDown 'insère des cellules
Target(1) = 1: Target.DataSeries 'numérotation
tablo = Target 'matrice, plus rapide
For i = 1 To nmax - n
    Do
        a = Application.RandBetween(1, nmax) 'numéro de ligne aléatoire
    Loop While tablo(a, 1) = ""
    tablo(a, 1) = ""
Next
Target = tablo 'restitution
Target.Sort Target, xlAscending, Header:=xlNo 'tri croissant pour accélérer
'Target.Sort Target, xlDescending, Header:=xlNo 'tri décroissant pour accélérer
If n < nmax Then Target.Resize(nmax - n).Offset(n).Delete xlUp 'supprime les cellules vides
End Sub
Fichier (2).

A+
 

Pièces jointes

  • Alea(2).xlsm
    17.7 KB · Affichages: 2

Dranreb

XLDnaute Barbatruc
Sur sélection de 2000 lignes d'une colonne, ceci est pratiquement instantané chez moi :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim LAt As New ListeAléat, TExtr() As Long, TRés(), L As Long
LAt.Init 10000
LAt.ExtraireClassés TExtr, Target.Rows.Count
ReDim TRés(1 To Target.Rows.Count, 1 To 1)
For L = 1 To UBound(TExtr): TRés(L, 1) = TExtr(L): Next L
Target.Value = TRés
End Sub
 

jmfmarques

XLDnaute Accro
A Job75
Pourquoi ai-je choisi de travailler non pas sur une plage de la colonne A, mais dans un tremplin (une collection) ?
Réponse : je ne vois nulle part écrit qu'il n'y a rien en regard de la plage agrandie (colonne B et suivantes) et que, si quelques présences, leur position relative ne doit pas être scrupuleusement respectée.
Il est vraisemblable que tel n'est pas le cas, mais rien, absolument rien, ne permet de l'affirmer.
Amitiés
 

Discussions similaires

Réponses
1
Affichages
593

Statistiques des forums

Discussions
312 105
Messages
2 085 350
Membres
102 870
dernier inscrit
Armisa