Trie aléatoire avec trois fixe

maval

XLDnaute Barbatruc
Bonjour,

J'ai code pour réaliser un trie aléatoire qui fonctionne très bien, mais j'aimerai lui apporté une modification en fonction de la demande.
Je m'explique dans un concours de belote il y a des personnes handicapées qui ont du mal a se déplacer, c'est pour cela que ses personnes doivent rester à leurs table pour toute l’après-midi et j'aimerai que trie se fasse normalement sur deux colonnes et en fonction du choix de la liste déroulante.
ex: si on a dans la liste déroulante le Nbr 3 il y aura les lignes "F3:G3, F5:G5,F7:G7" qui ne bougerons pas.

Je joint un fichier exemple

Merci de votre aide

Cordialement

Maval
 

Pièces jointes

  • Trie spécial.xls
    77.5 KB · Affichages: 29
  • Trie spécial.xlsm
    27.4 KB · Affichages: 37

job75

XLDnaute Barbatruc
Re : Trie aléatoire avec trois fixe

Bonjour à tous,

J'y vais de ma solution :

Code:
Sub Tri()
Dim NbLig As Long, i As Integer
Application.ScreenUpdating = False
NbLig = Range("G" & Rows.Count).End(xlUp).Row
Columns("H").Insert
With Range("H3:H" & NbLig)
  .Formula = "=RAND()"
  .Value = .Value
  For i = 1 To 2 * [K4] - 1 Step 2 'J4 est décalé...
    [H2].Offset(i) = Application.Small(.Cells, i) - "1E-15"
  Next
End With
Range("F3:H" & NbLig).Sort [H3], xlAscending, Header:=xlNo
Columns("H").Delete
End Sub
J'ai donc juste ajouté une petite boucle.

Fichier joint.

A+
 

Pièces jointes

  • Tri(1).xls
    83 KB · Affichages: 45
  • Tri(1).xls
    83 KB · Affichages: 46
  • Tri(1).xls
    83 KB · Affichages: 40

maval

XLDnaute Barbatruc
Re : Trie aléatoire avec trois fixe

Bonjour Job, Bernard, Bebere,

Je vous remercie beaucoup Nickel.....;
3 versions différente vraiment super..
A part que le code de Bébere j'ai un message d'erreur "L'indice n'appartient à la sélection" sur la ligne suivante

Code:
For i = UBound(tbl) To LBound(tbl) Step -1

Merci pour tous

Bonne journée à tous

Max
 

job75

XLDnaute Barbatruc
Re : Trie aléatoire avec trois fixe

Re,

Si l'on fait plusieurs essais sur le fichier de mon post #4 on finit par obtenir un résultat erroné.

En effet modifier la 15ème décimale finit par créer un classement erroné.

Cette solution devrait mieux fonctionner :

Code:
Sub Tri()
Dim NbLig&, tablo, ub&, i%, n#, j&
Application.ScreenUpdating = False
NbLig = Range("G" & Rows.Count).End(xlUp).Row
Columns("H").Insert
With Range("H3:H" & NbLig)
  .Formula = "=RAND()"
  tablo = .Value
  ub = UBound(tablo)
End With
For i = 1 To 2 * [K4] - 1 Step 2 'J4 est décalé...
  n = Application.Small(tablo, i)
  For j = 1 To ub
    If tablo(j, 1) >= n Then tablo(j, 1) = tablo(j, 1) + 1
  Next
  tablo(i, 1) = n
Next
[H3].Resize(ub) = tablo
Range("F3:H" & NbLig).Sort [H3], xlAscending, Header:=xlNo
Columns("H").Delete
End Sub
La macro est très rapide car elle utilise un tableau VBA.

Edit : .Value = .Value est ici inutile.

Fichier (2).

A+
 

Pièces jointes

  • Tri(2).xls
    92.5 KB · Affichages: 33
  • Tri(2).xls
    92.5 KB · Affichages: 32
  • Tri(2).xls
    92.5 KB · Affichages: 30
Dernière édition:

maval

XLDnaute Barbatruc
Re : Trie aléatoire avec trois fixe

Re Job

Je te remercie beaucoup.

Pourrez tu me dire comment tu ferai a ma place pour a chaque fois que je fait un trie j'aimerai ajouter la valeur 1 a la cellule J3 de la feuille 3 pour annoncer le N° de la partie en sachant qu'il y a 4 partie au total

Un grand merci d'avance

@+
Max
 

job75

XLDnaute Barbatruc
Re : Trie aléatoire avec trois fixe

Re maval,

Même la solution (2) de mon post #8 peut donner un résultat erroné (il se crée des doublons).

S'appuyer sur les nombres aléatoires pour reclasser n'est finalement pas une bonne solution.

Avec le couper-insertion des lignes concernées il est sûr qu'il n'y a plus de problème :

Code:
Sub Tri()
Dim NbLig As Long, i As Integer
Application.ScreenUpdating = False
NbLig = Range("G" & Rows.Count).End(xlUp).Row
Columns("H").Insert
With Range("H3:H" & NbLig)
  .Formula = "=RAND()"
  .Value = .Value
End With
For i = 1 To 2 * [K4] - 1 Step 2 'J4 est décalé...
  [H2].Offset(i) = 0 'pour placer les lignes en tête
Next
Range("F3:H" & NbLig).Sort [H3], xlAscending, Header:=xlNo
Columns("H").Delete
'reclassement par couper-insertion
For i = 1 To [J4]
  [F3:G3].Cut
  [F3.G3].Offset([J4] + 1 - i + 2 * (i - 1)).Insert xlDown
Next
End Sub
Fichier (3).

Edit : pour la question du post #9 mettre cette ligne en fin de macro :

Code:
Feuil3.[J3] = 1 + Feuil3.[J3] Mod 4 'CodeName
A+
 

Pièces jointes

  • Tri(3).xls
    92.5 KB · Affichages: 40
  • Tri(3).xls
    92.5 KB · Affichages: 40
  • Tri(3).xls
    92.5 KB · Affichages: 42
Dernière édition:

Statistiques des forums

Discussions
312 920
Messages
2 093 640
Membres
105 771
dernier inscrit
lorachab