Tri_aleatoire sans répéter les choix "jeu du pendu"

Bonsoir,

Merci pour ce forum et ceux qui y participent pour aider les autres .

s'il vous plait

Je cherche à améliorer le code : qui cherche aléatoirement les mots

sans les répéter au cellule J17 et obtenir des choix différents

le code est:

Sub tri_aleatoire()
Dim nb_alea  As Byte
nb_alea = Int(4 * Rnd()) + 1
Range("C2:D723").Select
    ActiveWorkbook.Worksheets("Mots").Sort.SortFields.Clear
    Select Case nb_alea
    Case 1:
    ActiveWorkbook.Worksheets("Mots").Sort.SortFields.Add Key:=Range("D3:D723"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        Case 2:
    ActiveWorkbook.Worksheets("Mots").Sort.SortFields.Add Key:=Range("D3:D723"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
   Case 3:
    ActiveWorkbook.Worksheets("Mots").Sort.SortFields.Add Key:=Range("C3:C723"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        Case 4:
    ActiveWorkbook.Worksheets("Mots").Sort.SortFields.Add Key:=Range("C3:C723"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    End Select

    With ActiveWorkbook.Worksheets("Mots").Sort
        .SetRange Range("C2:D723")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .Apply
    End With
End Sub

Il se trouve au bouton "nouveau" tri_aleatoire

et Merci d'avance.

Bonjour,

plutôt que de faire un tri aléatoire, je te propose d'aller chercher une valeur dans ta feuille "Mots", sur une ligne aléatoire, pour ça on peut utiliser la fonction Randomize, qui permet de générer un nombre aléatoire qui va nous servir pour la ligne, j'ai ainsi remplacé la fonction tri_aléatoire par:

Randomize    ' Initialise le générateur de nombres aléatoires.

With Sheets("Mots")
    ligDep = 3
    ligFin = .Range("c" & Rows.Count).End(xlUp).Row
    ' Renvoie une valeur aléatoire comprise entre 1 et 6.
    ligne = Int(((ligFin - ligDep + 1) * Rnd) + ligDep)
    Range("b5") = .Range("c" & ligne)
    Range("J7") = .Range("d" & ligne)
End With

la probabilité que le mot soit le même que le précédent est vraiment très très faible, comme tu as déjà plus de 600 mots, soit 1/600 * 1/600 = 1/36000 de chance de tomber sur le même mot, après on peut toujours gérer ce cas assez rare si tu le souhaites

le résultat est:

BONJOUR,

MR Ausecour

Merci infiniment pour ton aide

Mais J'ai téléchargé le fichier et c'est le même problème; le mot au J7 se répéte car le jeu se joue en cliquant sur Proposer pour saisir lettre l'un aprés l 'autre et en passant de la recherche d'un mot à l'autre

Merci encore

Ah oui en effet,

je n'avais pas totalement compris la problématique, voici une nouvelle version qui devrait aller cette fois:

Bonjour toutes et tous

petite contribution

code à placer dans ta feuille Jeu

Note:une fois 1 lettre saisie par double clic gauche de la souris efface le contenu sur les cellules E11 et F11 (cellules fusionnées)

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
' Supprime le contenu sur la feuille Jeu des 2 cellules fusionnées
' E11 et F11 de la feuille par double-clic gauche de la souris
On Error GoTo plouf
If Target.Address = Range("E11:F11").Address Then Target.ClearContents
plouf: Exit Sub
End Sub

crdlt,

André

Ausecour a écrit :

Ah oui en effet,

je n'avais pas totalement compris la problématique, voici une nouvelle version qui devrait aller cette fois:

jeu-du-pendu V3-1.xlsm

Bonsoir,

Merci beaucoup pour votre aide

cette fois le code de choisir les mots fonctionne bien

Mais le compteur du notes pour chaque partie de 10 mots ne fonctionne pas.

Bonjour,

en effet, comme j'appelais nouveau() à chaque fois, ça effaçait I18, j'ai modifié un peu le code et cette fois ça devrait être bon

voici le fichier modifié: