XL 2013 Amalgame de données

[BER2D2]

Bonjour à tous,

Je suis nouveau sur ce forum et j'ai besoin d'aide.
Mon problème est le suivant :
J'ai un tableau avec une colonne représentant des noms de villes et une autres des quantités liés a ces villes.
A coté de ce tableau j'ai 2 données (H5=le palier maxi et H6=le nombre d'amalgame maxi)

A B
Ville Quantité
Ville 1 10 000
Ville 2 11 000
Ville 3 12 000
Ville 4 10 000
Ville 5 20 000
Ville 6 22 000
Ville 7 20 000
Ville 8 21 000
Ville 9 30 000
Ville 10 20 500
Ville 11 22 000
Ville 12 40 000
Ville 13 41 000
Ville 14 50 000
Ville 15 43 000
Ville 16 40 500

H5 : 3000
H6: 4

Sachant que H5 peut varier, H6 peut aussi varié et le nombre de ville aussi .... dans mon exemple il ni en a que 16

L'objectif est de pouvoir :
1 - trouver la quantité mini -> ça c'est ok
2 - amalgamer (mettre ensemble) par H6 maximum le nombre de ville dont les quantité sont égale a H5 prêt.
Exemple, ici on devrait avoir :
Amalgame 1 : Ville 1 - 10 000, Ville 4 - 10 000, Ville 2 - 11 000, Ville 3 - 12 000
Amalgame 2 : Ville 5 - 20 000, Ville 7 - 20 000, Ville 10 - 20 500, Ville 8 - 21000
Amalgame 3 : Ville 6 - 22 000, Ville 11 - 22 000
Amalgame 4 : Ville 9 - 30 000
Amalgame 5 : Ville 12 - 40 000, Ville 16 - 40 500, Ville 13 - 41 000, Ville 15 - 43 000
Amalgame 6 : Ville 14 - 50 000

Dans cette exemple, si H6 avait été égale à 6 , Amalgame 2 aurait été : Ville 5 - 20 000, Ville 7 - 20 000, Ville 10 - 20 500, Ville 8 - 21000, Ville 6 - 22 000, Ville 11 - 22 000
et il ni aurait eut que 5 amalgames au lieu de 6

Est ce que quelqu'un permis vous est capable de m'expliquer comment je pourrais faire ça avec des formules Excel ?

Merci d'avance pour votre aide

 

[job75]

Bien sûr on peut se passer du bouton, voyez ce fichier (2) avec dans le code de la feuille :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ecart#, nombre%, tablo, ub&, resu(), deb&, maxi#, i&, j%, n&
ecart = [H5]: nombre = [H6] 'à adapter
Application.ScreenUpdating = False
With [Tableau1] 'tableau structuré
    .Sort .Columns(2), xlAscending, Header:=xlYes 'tri sur les quantités
    tablo = .Resize(, 2) 'matrice, plus rapide
    .Sort .Columns(1), xlAscending 'tri sur les villes
End With
ub = UBound(tablo)
ReDim resu(1 To ub, 1 To 1)
deb = 1
1 maxi = tablo(deb, 2) + ecart
For i = deb To ub
    If tablo(i, 2) <= maxi And j < nombre Then
        j = j + 1
        If j = 1 Then n = n + 1: resu(n, 1) = "Amalgame " & n & " : "
        resu(n, 1) = resu(n, 1) & IIf(j = 1, "", ", ") & tablo(i, 1) & " - " & tablo(i, 2)
    Else
        j = 0
        deb = i
        GoTo 1
    End If
Next
'---restitution---
Application.EnableEvents = False 'désactive les évènements
With [D8] 'cellule à adapter
    If n Then .Resize(n) = resu
    .Offset(n).Resize(.Parent.Rows.Count - n - .Row + 1).ClearContents 'RAZ en dessous
End With
Application.EnableEvents = True 'réactive les évènements
End Sub

La macro se déclenche automatiquement quand on modifie ou valide une cellule quelconque.