Scinder une liste en 2 parts égales

Bonjour,

J'ai créer sur excel 2010 une liste avec 2 colonnes (nom et numéro) et je souhaiterai couper cette liste en 2, de façon à ce que le total des numéro de chaque liste soit le plus proche possible.

J'ai beau chercher un peu partout sur internet je ne trouve pas de solution, c'est pour cela que je fais appel à vous en esperant que vous trouverez une solution

Merci d'avance.

Fichier Joint.

UP

bonjour

le nombre de personnes doit-il être le même pour chaque liste ?

Bonjour,

Oui le nombre de personne doit être égale, il est impossible de modifier leur numéro ou de les faire apparaître plusieurs fois dans les listes

Si ça peut aider, ce sont des équipes et chaque numéro représente leur niveau, pour que les équipes soient le plus équilibré possible les totals de chaque équipe doit être le plus proche possible

Merci.

Bonjour,

une proposition de solution

Sub aargh()
    Dim a
    Dim s
    dl = Cells(Rows.Count, 1).End(xlUp).Row
    With Range("A2:B" & dl)
        '.Sort key1:=Range("b1"), order1:=xlAscending, Header:=xlNo
        a = .Value
        m = Application.WorksheetFunction.Sum(Range("B2:B" & dl)) / 2
        t = 0
        ReDim s(LBound(a, 1) To UBound(a, 1))
        totpoids sol, s, m, a
        s = Split(sol, ",")
        k1 = 1
        k2 = k1
        For i = LBound(s) To UBound(s)
            If s(i) <> 0 Then
                k1 = k1 + 1
                Cells(k1, 3) = Cells(i + 2, 1)
                Cells(k1, 4) = Cells(i + 2, 2)
            Else
                k2 = k2 + 1
                Cells(k2, 5) = Cells(i + 2, 1)
                Cells(k2, 6) = Cells(i + 2, 2)
            End If
        Next i
    End With
End Sub
Sub totpoids(ByRef sol, ByRef s, m, a, Optional t = 0, Optional j = 1, Optional n = 1, Optional max = 1000000#)
    For i = j To UBound(a, 1)
        t = t + a(i, 2)
        s(i) = 1
        If n < UBound(a, 1) / 2 Then
            totpoids sol, s, m, a, t, i + 1, n + 1, max
        ElseIf Abs(t - m) < max Then
            max = Abs(t - m)
            sol = Join(s, ",")
        End If
        t = t - a(i, 2)
        s(i) = 0
    Next i
End Sub

Re,

Comment fait-on fonctionner cet algorithme ?

J'ai essayé de le coller dans virtual basis dans "feuil1" mais il m'affiche une erreur de compatibilité

Je n'ai jamais vraiment toucher à cette partie "developpeur" dans excel donc je suis un peu perdu

re-bonjour,

macro intégrée au fichier exemple

pout ton info :

pour inclure cet algorithme dans le classeur

sélectionner le code sur le forum,

puis le copier Ctrl-C

dans excel faire ALT-F11 pour démarrer l'éditeur VBA

choisir menu insérer module

coller le code CTRL-V

faire ALT-F11 pour revenir à excel

faire ALT-F8 pour lancer la macro (ici aargh)

C'est impeccable, ça marche super bien !

Merci beaucoup pour ton aide et toutes tes explications