XL 2013 Amalgame de données

BER2D2 · 17 Juillet 2020

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 · 17 Juillet 2020

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

VB:

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.

XL 2013 Amalgame de données

BER2D2

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Pièces jointes

Discussions similaires

XL 2013 Amalgame de données

BER2D2

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Pièces jointes

Discussions similaires

Privacy & Transparency

Privacy & Transparency