MélangerDiviser beug dans le code

Bonjour

j'ai une erreur dans ce code que je ne trouve pas

le beug est sur cette ligne

les données sont en colonne A à partir de A3 il 's'agit de chiffres

Merci pour votre aide

valeurs(i) = valeurs(j)

Sub MelangerEtDiviser()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Feuil1") ' Changez "Feuil1" par le nom de votre feuille

    Dim rng As Range
    Dim cell As Range
    Dim valeurs As Collection
    Dim i As Long, j As Long
    Dim n As Long

    ' Récupérer les valeurs de la colonne A à partir de A3
    Set rng = ws.Range("A3:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
    Set valeurs = New Collection

    ' Ajouter les valeurs à la collection
    On Error Resume Next
    For Each cell In rng
        valeurs.Add cell.Value
    Next cell
    On Error GoTo 0

    ' Mélanger les valeurs
    Randomize
    For i = valeurs.Count To 2 Step -1
        j = Int((i - 1) * Rnd) + 1
        ' Échanger les valeurs
        Dim temp As Variant
        temp = valeurs(i)
        valeurs(i) = valeurs(j)     'LE BEUG EST ICI
        valeurs(j) = temp
    Next i

    ' Diviser en 4 colonnes (C, D, E, F)
    n = valeurs.Count
    For i = 1 To n
        ws.Cells(i + 2, 3 + (i - 1) Mod 4).Value = valeurs(i)
    Next i

    ' Diviser en 6 colonnes (L, M, N, O, P, Q)
    For i = 1 To n
        ws.Cells(i + 2, 12 + (i - 1) Mod 6).Value = valeurs(i)
    Next i
End Sub

Hello,

4. Les collections sont en lecture seule alors que les valeurs des tableaux peuvent être modifiées à l’aide de VBA. Avec une collection, vous devez d’abord supprimer la valeur à modifier, puis ajouter la nouvelle valeur modifiée.

extrait de https://www.automateexcel.com/fr/vba/collections/

Bonjour

Merci pour la réponse mais cela n'apporte pas la solution au problème

Crdlt

Salut @Joco,

Tu ne peux pas éditer les valeurs d'une collection une fois qu'elles y sont entrées. Il faut supprimer la valeur et la réinsérer. Mais c'est compliqué, car c'est un bazard de déplacer tous les indices…

A mon avis tu n'as pas besoin d'une collection. Tu devrais plutot utiliser une ArrayList et un dictionnaire, comme ceci par exemple :

Pour info, comme tu as Excel 2021, j'ai utilisé la fonction de RandArray/TABLEAU.ALEA (RANDARRAY function - Microsoft Support) pour générer une liste de nombres aléatoires instantanément.

Ensuite il suffit de trier ta liste de nombres par cette liste aléatoire pour tout mélanger.

Note : il faut .Net 3.5 pour utiliser les arraylist

Sub MelangerEtDiviser()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(1) ' Changez "Feuil1" par le nom de votre feuille

    ' Récupérer les valeurs de la colonne A à partir de A3
    Dim mesVals As Variant, clesRnd As Variant
    With WorksheetFunction
      mesVals = .Transpose(ws.Range("A3:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row).Value2)
      clesRnd = .Transpose(.RandArray(UBound(mesVals)))
    End With
    ' une table de correspondance : cle aleatoire : valeur
    Dim dictCorresp As Object
    Set dictCorresp = CreateObject("Scripting.Dictionary")
    ' on utilise une arraylist pour avoir la fonction .Sort, au lieu de l'ecrire nous meme
    Dim clesTriees As Object
    Set clesTriees = CreateObject("System.Collections.ArrayList")
    Dim i As Long
    For i = LBound(mesVals) To UBound(mesVals)
      dictCorresp(clesRnd(i)) = mesVals(i)
      clesTriees.Add clesRnd(i)
    Next i

    ' tri des cles = rangement aleatoire
    clesTriees.Sort
    ' réarangement des valeurs en suivant le tri aleatoire
    For i = 0 To clesTriees.Count - 1
      mesVals(i + 1) = dictCorresp(clesTriees(i))
    Next i

    ' Diviser en 4 colonnes (C, D, E, F)
    For i = LBound(mesVals) To UBound(mesVals)
        ws.Cells(i + 2, 3 + (i - 1) Mod 4).Value = mesVals(i)
    Next i
'
    ' Diviser en 6 colonnes (L, M, N, O, P, Q)
    For i = LBound(mesVals) To UBound(mesVals)
        ws.Cells(i + 2, 12 + (i - 1) Mod 6).Value = mesVals(i)
    Next i
End Sub

Bonjour saboh12617

Merci pour ton aide

Après essai j'ai un beug sur cette ligne de ton code

Set clesTriees = CreateObject("System.Collections.ArrayList")

Ah oui, c'est ce que j'écrivais en italique.

Si vous le pouvez, installez ceci Download .NET Framework 3.5 SP1 | Free official downloads

Cela vous permettra d'utiliser de nouveaux outils en VBA, les ArrayLists (qui sont un peu comme des collections mais en mieux), qui disposent de la fonction .Sort.

Sinon il faudra que je vous écrive une fonction pour trier une Array VBA, mais c'est moins efficace.

Bonjour Joco7915, à tous les autres,

Une collection n'est pas du tout adaptée à votre cas. Pour mélanger des valeurs, un tableau en mémoire (array) et une boucle est ce qui se fait de plus rapide et de plus simple (selon moi) et ça reste compatible MAC puisque qu'on utilise pas d'objet spécifique à Windows.

Voyez le code ci-dessous dans module1. Pour l'affichage des résultats, tout est paramétrable dans le code via les variables cellresult (cellule résultat) et nbrcol (nombre de colonnes) :

Sub MelangerEtDiviser()
   Dim ws As Worksheet, t, i As Long, j As Long, n As Long, temp As Variant, cellresult As Range, nbrcol As Long

   Set ws = ThisWorkbook.Sheets("Feuil1")    ' Changez "Feuil1" par le nom de votre feuille
   ' Récupérer les valeurs de la colonne A à partir de A3
   t = ws.Range("A3:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)

   ' Mélanger les valeurs
   Randomize
   n = UBound(t)
   For i = 1 To n
       j = 1 + Int(Rnd * n)
       temp = t(i, 1): t(i, 1) = t(j, 1): t(j, 1) = temp      ' Échanger les valeurs
   Next i

   ' à partir de la cellule cellresult, diviser en nbrcol colonnes
   Application.ScreenUpdating = False
   Set cellresult = ws.Range("c3")     ' cellule de base du résultat
   nbrcol = 4                          ' nombre de colonnes
   cellresult.CurrentRegion.Clear      ' effacer les anciens résultats
   For i = 1 To n                      ' boucle d'affichage
       cellresult.Offset(Int((i - 1) \ nbrcol), (i - 1) Mod nbrcol) = t(i, 1)
   Next i

   ' à partir de la cellule cellresult, diviser en nbrcol colonnes
   Set cellresult = ws.Range("L3")     ' cellule de base du résultat
   nbrcol = 6                          ' nombre de colonnes
   cellresult.CurrentRegion.Clear      ' effacer les anciens résultats
   For i = 1 To n                      ' boucle d'affichage
       cellresult.Offset(Int((i - 1) \ nbrcol), (i - 1) Mod nbrcol) = t(i, 1)
   Next i
End Sub

Bonjour mafraise

Exactement ce dont j'avais besoin

Au premier essai cela fonctionne nickel

Merci bonne journée

Re,

Une version v2 beaucoup plus rapide parce qu'on passe aussi par un array pour l'affichage des résultats. La v2 traite 100 00 éléments en entrée et s'exécute en 0,25 s (sur ma bécane).

Sub MelangerEtDiviser()
Dim ws As Worksheet, t, i&, j&, n&, temp As Variant, cellresult As Range, nbrcol&
   Set ws = ThisWorkbook.Sheets("Feuil1")                            ' la feuille
   t = ws.Range("A3:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row) ' récup valeurs

   Randomize
   n = UBound(t)
   For i = 1 To n             ' boucle sur les valeurs
       j = 1 + Int(Rnd * n)   ' indice j pour échanger les valeurs i et j
       temp = t(i, 1): t(i, 1) = t(j, 1): t(j, 1) = temp    ' Échange de i et j
   Next i

   ' à partir de la cellule cellresult, diviser en nbrcol colonnes
   Application.ScreenUpdating = False
   Set cellresult = ws.Range("c3")                    ' cellule de base du résultat
   nbrcol = 4                                         ' nombre de colonnes
   ReDim res(1 To 1 + Int(n / nbrcol), 1 To nbrcol)   ' création de l'array des résultats
   For i = 1 To n                                     ' boucle de remplissage de res
       res(1 + Int((i - 1) / nbrcol), 1 + (i - 1) Mod nbrcol) = t(i, 1)
   Next i
   cellresult.CurrentRegion.Clear                        ' effacer les anciens résultats
   cellresult.Resize(UBound(res), UBound(res, 2)) = res  ' tranférer le résultat sur la feuille

   ' à partir de la cellule cellresult, diviser en nbrcol colonnes
   Application.ScreenUpdating = False
   Set cellresult = ws.Range("L3")                    ' cellule de base du résultat
   nbrcol = 6                                         ' nombre de colonnes
   ReDim res(1 To 1 + Int(n / nbrcol), 1 To nbrcol)   ' création de l'array des résultats
   For i = 1 To n                                     ' boucle de remplissage de res
       res(1 + Int((i - 1) / nbrcol), 1 + (i - 1) Mod nbrcol) = t(i, 1)
   Next i
   cellresult.CurrentRegion.Clear                        ' effacer les anciens résultats
   cellresult.Resize(UBound(res), UBound(res, 2)) = res  ' tranférer le résultat sur la feuille
End Sub

Re bonjour mafraise

effectivement ton fichier 2 est rapide

je te remets le fichier 1 pour résoudre un problème de doublons (annotations sur la feuil)

une tentative,

Bonjour Bart,

Merci pour ta solution

Question 1° comment je fais pour changer le nombre de participants ?

2° quand on fait le tirage il manque 1 chiffre dans les tableaux duos et trios

re,

votre exemple était avec 47 personnes. Maintenant, c'est un TS, donc il faut ajouter/supprimer des lignes.

Merci Bart c'est ce dont j'ai besoin.

Bonne fin de journée

Crdlt

Bonjour à tous,

Je me suis amusé à généraliser un peu le problème.

En début de module, il y a des constantes qui permettent de choisir :

• Le nombre de membres de chaque équipe pour le premier tour
• Le nombre de membres de chaque équipe pour le second tour
• La cellule de base pour l'affichage du résultat
• Le nombre d'essai maximum à faire pour trouver une solution sans qu'un participant au premier tour ne se retrouve dans une équipe au second tour qui contient un de ses partenaires du premier tour

Cliquer sur le bouton Hop!

Dans le classeur, on a fixé pour taille d'équipe 4 pour le 1^ier tour et 5 pour le 2^ème tour. Le nombre de participantes est 130. Avec ces données, on arrive à devoir faire plusieurs centaines d'essai avant de trouver une solution. Les résultats s'affichent à partir à partir de la cellule E3.

Pour retrouver votre cas, fixer la constante nbrMembre1 à 2 et la constante nbrMembre2 à 3.

Le code est un peu commenté.

• Suivant les valeurs des constantes et le nombre total de participants, il peut ne pas exister de solution.
• si on dépasse le nombre maximum d'essais, cela ne signifie pas forcément qu'il n'y a pas de solution. C'est peut-être simplement qu'on a pas pu faire assez d'essais pour en trouver une. Quelquefois, en relançant on peut tomber sur une des solutions (ou pas)
• avec ma méthode, on ne saura pas distinguer si on est dans le premier cas ou le second.

re, pour un dimanche, c'est amusant

la différence entre les 2 méthodes, c'est que mafraise cherche avec "brute force" multiples solutions pendant max 50.000 fois. Ma méthode est, je fais un tirage aléatoire et puis j'essaie à amériorer cette tirage pendant 1.000 fois. (ces chiffres ne sont pas important pour le moment). Dans les cas faciles, dès qu'on a une solution, la méthode n'est pas intéressante, mais dans les cas difficiles ... ,

Je l'ai essayé avec 100 personnes et des equipes de 5 et 6, ... .

Peut-être qu mafraise pourrait mémoriser la meilleur non-solution, dans le cas où il n'avait pas trouvé une ...

Bon, dans les cas où il n'y a pas une solution, ma méthode montrera déjà cela.

PS. choississez la méthode "mafraise" pour les problèmes simples et la mienne pour les problèmes complexes

Bonjour mafraise ,Bart

Bonjour Joco7915 ,

Merci pour ton retour,

Bonjour BsAlv ,

Ta méthode est beaucoup plus efficace .

Tu suggères de mémoriser (bonne idée ) et d'afficher la meilleure solution (qui est sans doute celle avec le nombre minimum de doublons/collisions). Quand j'aurais un peu de temps, je m'y attèlerai. Mais cela m'obligera à augmenter le temps de chaque tirage puisque je devrais compter le nombre de collisions pour tous les participants alors, qu'actuellement, j'interromps la recherche de collisions dès la première collision rencontrée et je passe au tirage suivant.

Nonobstant ce fait, ce sera très intéressant à faire malgré tout .