Choix prenom au hasard

Merci.

J'ai essaye d'ajouter des personnes sur la table d' h2so4 mais j'obtiens beaucoup de doublons ( surlignes en jaune dans le fichier joins)

Cdtl

Bonjour,

tableau adapté pour un nombre de personnes variables (formules copiées pour gérer 40 personnes, tirer les formules vers le bas et vers la droite si plus de personnes).

Mon cher h2so4, tous mes respects

Tu as donc créé une table de berger dimension 40

Regarde dans qwant ou google, tu n'en trouveras pas sous excel ! c'est du pur génie !

Bonsoir,

solution via macro

Tu es toujours plus rapide ... je viens de sortir ma version à partir d'une macro sur laquelle j'avais commencé à travailler il y a fort longtemps (merci à son auteur).

Les rencontres se lisent en horizontal (et non vertical).

Sub test()
    TNom = [T].Value
    TBerger = BERGER(UBound(TNom), UBound(TNom))
    For i = 1 To UBound(TBerger, 1)
        For j = 1 To UBound(TBerger, 2)
            TBerger(i, j) = TNom(TBerger(i, j), 4)
        Next
    Next
    With Worksheets("resultat")
        .Range("A1").CurrentRegion.Offset(1, 0).ClearContents
        .Range("A2").Resize(UBound(TBerger, 1), UBound(TBerger, 2)) = TBerger
        .Select
    End With
End Sub

Function BERGER(p%, q%)
' auteur inconnu
Dim i%, j%, k%, r%
ReDim m(1 To p + p Mod 2 - 1, p + p Mod 2)
ReDim u%(p + p Mod 2)
    If p > 1 And p >= q And q > 0 Then
        r = 2 * ((q + 1) \ 2)
        For i = 1 To q
            If i < r Then m(i, 0) = i
            For j = 1 To q
                k = (((1 - ((i = r) Or (j = r))) * (i + j - 2)) Mod (r - 1) + 1) * ((i + j - (i > j)) Mod 2)
                If k Then
                    u(k) = u(k) + 2
                    m(k, u(k) - 1) = i
                    m(k, u(k)) = j
                End If
            Next j
        Next i
    End If
    BERGER = m
End Function

nota : l'intérêt de l'aléa in fine est faible sis le nombre de rencontres est suffisant pour que tout le monde voit tout le monde !

Cette fois-ci j'ai réussi à produire mon propre code (juste pour me décrasser les neurones)

Extrait (core)

    Dim ba() As Variant, bs() As Variant, n() As Variant
    ReDim ba(1 To p / 2, 1 To 2 * (p - 1))
    ReDim bs(1 To p / 2, 1 To 2 * (p - 1))
    ReDim n(1 To p - 1)
    For i = 1 To p
        m = 2 * i - 1
        If m >= p Then m = m - p + 1
        For j = i + 1 To p
            If m = p Then m = 1
            If m = i - 1 Then m = 2 * (i - 1)
            If m >= p Then m = m - p + 1
            n(m) = n(m) + 1
            ba(n(m), 2 * m - 1) = t(i, 4): ba(n(m), 2 * m) = t(j, 4)
            bs(n(m), 2 * m - 1) = t(i, 1): bs(n(m), 2 * m) = t(j, 1)
            m = m + 1
        Next
    Next

Cela fonctionne aussi pour un nombre impair ...

Applications : speed-dating, poules de championnat