formule ou macro pour dissocier 2 listes

[jeanjacques]

Bonjour,

Quelqu'un pourrait m'aider à séparer une liste initiale en 2 listes le plus disjointes possibles?


Bon dimanche.

 

[Paf]

Bonjour,

Quelqu'un pourrait m'aider à séparer une liste initiale en 2 listes le plus disjointes possibles?

et extrait du classeur :

Séparation de la liste initiale en 2 listes contenant le maximum de nombres identiques dans chaque liste.

Quelle demande faut-il prendre?

et quelques précisions....

A+

 

[jeanjacques]

Bonjour Paf,
Les 2 listes doivent être au maximum différentes (nombres identiques dans une liste et les autres nombres identiques dans la 2ème, une séparation en 2) Un fichier séparé en 2 fichiers contenant le moins de nombres communs aux 2. Bien sûr il y aura forcément des nombres en commun aux 2 listes (intersection d'ensembles) comme le 8 dans mon exemple, mais je voudrais le moins possible. ce serait bien d'afficher en rouge les erreurs et le % mais c'est un gadget. MERCI

 

[Paf]

re, avec du retard

un essai macro:

on 'regroupe' les différents nombres puis on les affecte d'abord dans tableau, puis les derniers dans un second.

ce qui ne représente qu'une solution parmi celles possibles, et ce n'est pas forcément la plus optimisée.

Sub Sépare()
Dim dico, i As Long, derL As Long, Plage As Range, TR, Ta, Tb, x As Long
Dim Li As Integer, cel As Range, j As Long, Clé, k As Long
Set dico = CreateObject("Scripting.Dictionary")
Set Plage = Range("A2:E" & Range("A" & Rows.Count).End(xlUp).Row)
Li = Round((Round(Plage.Count / 2, 0)) / 5, 0) * 5
ReDim TR(1 To Li, 1 To 2)
ReDim Ta(1 To Li / 5, 1 To 5)
ReDim Tb(1 To Li / 5, 1 To 5)

For Each cel In Plage
    dico(CStr(cel)) = dico(CStr(cel)) + 1
Next
j = 1

For Each Clé In dico.keys
    For i = 1 To dico(Clé)
        x = x + 1
        If x > Li Then
            x = 1: j = 2
        End If
        TR(x, j) = Clé
    Next
Next
For i = 1 To UBound(Ta, 1)
    For j = 1 To UBound(Ta, 2)
        k = k + 1
        Ta(i, j) = TR(k, 1)
        Tb(i, j) = TR(k, 2)
    Next
Next
Range("G2").Resize(UBound(Ta, 1), UBound(Ta, 2)) = Ta
Range("M2").Resize(UBound(Tb, 1), UBound(Tb, 2)) = Tb

End Sub

A+

 

[jeanjacques]

Bonjour Paf,

C'est l'idée....mais en conservant les listes de nombres sur chaque ligne (voit mon exemple merci), pas de "mélange" chaque série de 5 nb est conservée telle quelle.

a++