XL 2021 Tentatives de modifier aléatoirement l'ordre dans une colonne de cellules, le nombre de cellules concernées pouvant varier.

sylvanu à dit:

Bonjour à tous deux,
@Dranreb,
Je pense que votre solution VBA du post #8 est préférable. 🙂
Imaginons une liste en TDS de 100 mots. On veut l'updater par une nouvelle liste de 50 mots.
Si l'utilisateur l'efface simplement et remet sa nouvelle liste, alors se baser sur la profondeur du TDS ne marchera pas il sera toujours de 100.
Modifier le VBA posera moins de soucis à Matlea qui ne semble pas maitriser les TDS. ( sans vous offusquer Matlea 😉)

Cliquez pour agrandir...

Dranreb à dit:

1) — Supprimez les lignes du tableau dont la Colonne1 est vide.
2) — En Tableau2[Colonne2] :

Code:

=Hasard(LIGNE()-LIGNE(Tableau2[#En-têtes]);[Colonne1];Tutu)

3) — Si vous avez besoin d'ajouter un nouveau nom, tapez le en dessous du tableau: celui-ci s'agrandira automatiquement d'une ligne et la formule suivra.

Cliquez pour agrandir...

job75 à dit:

Bonjour à tous,

Il me semble que la fonction VBA de Dranreb complique les choses, avec cette macro c'est relativement simple :

VB:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim pas&, LO As ListObject, P As Range, mem
pas = 2 'modifiable
Set LO = Target(1).ListObject
If Not LO Is Nothing Then
    Set P = LO.Range
    If Target.Address = P(1).Address Then
        Cancel = True
        If P.Columns.Count = 1 Then MsgBox "Le tableau doit avoir au moins 2 colonnes...": Exit Sub
        mem = P.Columns(1) 'mémorise les valeurs
        Application.ScreenUpdating = False
        P.Columns(2).Offset(1).ClearContents 'vide la 2ème colonne
        P.Sort P(1), xlAscending, Header:=xlYes 'tri de la 1ère colonne
        P(2, 2).Formula = "=OFFSET(" & P(2, 1).Address & "," & pas & "*(ROW()-" & P.Row + 1 & "),)"
        P.Columns(2) = P.Columns(2).Value 'supprime les formules
        P.Columns(2).Replace 0, "", xlWhole 'supprime les valeurs zéro
        With P.Resize(Application.CountA(P.Columns(2)))
            .Columns(1) = "=RAND()" 'ALEA()
            .Sort .Columns(1), Header:=xlYes 'tri aléatoire
        End With
        P.Columns(1) = mem 'remise en l'état initial
    End If
End If
End Sub

Faire un double-clic sur la 1ère en-tête du tableau structuré.

Avec pas = 1 tous les éléments de la 1ère colonne sont récupérés.

A+

Cliquez pour agrandir...

MATLEA à dit:

Pourriez-vous dire à un néophyte comme moi comment copier cette macro dans un autre fichier?

Cliquez pour agrandir...

job75 à dit:

Le fichier doit être enregistré sous le format .xlsm.

Clic droit sur l'onglet => Visualiser le code et y coller la macro du post #22.

Cliquez pour agrandir...

job75 à dit:

Vous avez mis comme solution le post #23.

Or ce post est votre post ce n'est pas lui qu'il faut cocher.

Cochez mon post #22 pour que ça ait un sens.

Cliquez pour agrandir...

job75 à dit:

Bonjour MATLEA, le forum,

La suppression des zéros dans la 2ème colonne n'est pas une bonne solution car il peut y avoir des valeurs sous le tableau.

Utilisez plutôt cette macro :

VB:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim pas&, LO As ListObject, P As Range, mem, h&
pas = 2 'modifiable
Set LO = Target(1).ListObject
If Not LO Is Nothing Then
    Set P = LO.Range
    If Target.Address = P(1).Address Then
        Cancel = True
        If P.Columns.Count = 1 Then MsgBox "Le tableau doit avoir au moins 2 colonnes...": Exit Sub
        mem = P.Columns(1) 'mémorise les valeurs
        Application.ScreenUpdating = False
        P.Columns(2).Offset(1).ClearContents 'vide la 2ème colonne
        P.Sort P(1), xlAscending, Header:=xlYes 'tri de la 1ère colonne
        P(2, 2).Formula = "=OFFSET(" & P(2, 1).Address & "," & pas & "*(ROW()-" & P.Row + 1 & "),)"
        P.Columns(2) = P.Columns(2).Value 'supprime les formules
        h = Application.CountA(P.Columns(1))
        h = Application.Ceiling((h - 1) / pas, 1) + 1
        If h < P.Rows.Count Then P.Rows(h + 1).Resize(P.Rows.Count - h).ClearContents
        With P.Resize(h)
            .Columns(1) = "=RAND()" 'ALEA()
            .Sort .Columns(1), Header:=xlYes 'tri aléatoire
        End With
        P.Columns(1) = mem 'remise en l'état initial
    End If
End If
End Sub

Et marquez ce post comme solution.

A+

Cliquez pour agrandir...

MATLEA à dit:

ok


Cher job75

merci beaucoup. Compétence, réactivité, suivi, commentaires clairs et didactiques. Très impressionnant, félicitations.

Cliquez pour agrandir...