XL 2019 Meilleure option suivant les valeurs

[cotignac]

Bonjour,

Je cherche à connaître la meilleure option dans le fichier ci-joint. Cette option étant représenté par exemple par :
A1-B2-C4-D6-E8-F3
A chaque valeur est associée deux nombres, ex : A1 est associée à 0,15 et 15.
Il s'agit d'avoir un seul élément de type A, puis un seul élément de type B, un seul élément de type C etc..
La contrainte est matérialisée en B1 et B2 pour la fourchette de valeur où doivent se situer la somme des valeurs des colonnes D, H, L, P, T, X.
La meilleure option étant ensuite le nombre le plus haut de la somme des colonnes E, I, M, Q, U, Y.
J'aimerai, si c'est faisable, obtenir à partir de mon tableau une liste respectant la contrainte donnée par B1 et B2, où l'on aurait par exemple :
A7-B28-C2 -D3-E1-F3 puis 2 (somme des valeurs des colonnes intermédiaires) et 293 (sommes des valeurs des dernières colonnes).
L'idéal étant de pouvoir changer les valeurs B1 et B2 si nécessaire pour modifier la liste.

En vous remerciant par avance pour votre aide,

 

[JHA]

Bonjour à tous,

Peut-être un début

JHA

 

[cotignac]

Bonjour JHA,

Merci pour le retour, mais désolé je ne comprends pas quoi faire.

 

[JHA]

Bonjour à tous,

Avec ce que je comprends, je fais ressortir la plus grande valeur étant dans la limite haute et basse.

Après, je n'ai pas compris ce que tu veux de ces valeurs, je me suis donc arrêté là.

JHA

 

[job75]

Bonjour cotignac, JHA, le forum,

Voici une solution VBA, le plus simple est d'étudier toutes les combinaisons possibles :

Sub Calcul()
Dim inf, sup, A, ua&, B, ub&, C, uc&, D, ud&, E, ue&, F, uf&, aa&, bb&, cc&, dd&, ee&, ff&, s1#, s2#, liste$, mem2#, mem1#
inf = [B1]
sup = [B2]
A = [C5].CurrentRegion: ua = UBound(A)
B = [G5].CurrentRegion: ub = UBound(B)
C = [K5].CurrentRegion: uc = UBound(C)
D = [O5].CurrentRegion: ud = UBound(D)
E = [S5].CurrentRegion: ue = UBound(E)
F = [W5].CurrentRegion: uf = UBound(F)
For aa = 1 To ua
    For bb = 1 To ub
        For cc = 1 To uc
            For dd = 1 To ud
                For ee = 1 To ue
                    For ff = 1 To uf
                        s1 = A(aa, 2) + B(bb, 2) + C(cc, 2) + D(dd, 2) + E(ee, 2) + F(ff, 2)
                        If s1 >= inf And s1 <= sup Then
                            s2 = A(aa, 3) + B(bb, 3) + C(cc, 3) + D(dd, 3) + E(ee, 3) + F(ff, 3)
                            If s2 > mem2 Then
                                liste = A(aa, 1) & "-" & B(bb, 1) & "-" & C(cc, 1) & "-" & D(dd, 1) & "-" & E(ee, 1) & "-" & F(ff, 1)
                                mem1 = s1
                                mem2 = s2
                            End If
                        End If
Next ff, ee, dd, cc, bb, aa
If liste = "" Then [G1:G3] = "": Exit Sub
[G1] = liste
[G2] = mem1
[G3] = mem2
End Sub

A+

 

[cotignac]

Bonjour cotignac, JHA, le forum,

Voici une solution VBA, le plus simple est d'étudier toutes les combinaisons possibles :

Sub Calcul()
Dim inf, sup, A, ua&, B, ub&, C, uc&, D, ud&, E, ue&, F, uf&, aa&, bb&, cc&, dd&, ee&, ff&, s1#, s2#, liste$, mem2#, mem1#
inf = [B1]
sup = [B2]
A = [C5].CurrentRegion: ua = UBound(A)
B = [G5].CurrentRegion: ub = UBound(B)
C = [K5].CurrentRegion: uc = UBound(C)
D = [O5].CurrentRegion: ud = UBound(D)
E = [S5].CurrentRegion: ue = UBound(E)
F = [W5].CurrentRegion: uf = UBound(F)
For aa = 1 To ua
    For bb = 1 To ub
        For cc = 1 To uc
            For dd = 1 To ud
                For ee = 1 To ue
                    For ff = 1 To uf
                        s1 = A(aa, 2) + B(bb, 2) + C(cc, 2) + D(dd, 2) + E(ee, 2) + F(ff, 2)
                        If s1 >= inf And s1 <= sup Then
                            s2 = A(aa, 3) + B(bb, 3) + C(cc, 3) + D(dd, 3) + E(ee, 3) + F(ff, 3)
                            If s2 > mem2 Then
                                liste = A(aa, 1) & "-" & B(bb, 1) & "-" & C(cc, 1) & "-" & D(dd, 1) & "-" & E(ee, 1) & "-" & F(ff, 1)
                                mem1 = s1
                                mem2 = s2
                            End If
                        End If
Next ff, ee, dd, cc, bb, aa
If liste = "" Then [G1:G3] = "": Exit Sub
[G1] = liste
[G2] = mem1
[G3] = mem2
End Sub

A+

Merci à tous les deux pour vos retours, la solution est parfaite job75, un grand merci

 

[job75]

Il peut exister plusieurs listes optimales avec le même maximum Somme 2.

Pour les trouver toutes il faut modifier la macro :

Sub Calcul()
Dim inf, sup, A, ua&, B, ub&, C, uc&, D, ud&, E, ue&, F, uf&, liste$(), aa&, bb&, cc&, dd&, ee&, ff&, s1#, s2#, mem2#, i%, mem1#()
inf = [B1]
sup = [B2]
A = [C5].CurrentRegion: ua = UBound(A)
B = [G5].CurrentRegion: ub = UBound(B)
C = [K5].CurrentRegion: uc = UBound(C)
D = [O5].CurrentRegion: ud = UBound(D)
E = [S5].CurrentRegion: ue = UBound(E)
F = [W5].CurrentRegion: uf = UBound(F)
ReDim liste(0)
For aa = 1 To ua
    For bb = 1 To ub
        For cc = 1 To uc
            For dd = 1 To ud
                For ee = 1 To ue
                    For ff = 1 To uf
                        s1 = A(aa, 2) + B(bb, 2) + C(cc, 2) + D(dd, 2) + E(ee, 2) + F(ff, 2)
                        If s1 >= inf And s1 <= sup Then
                            s2 = A(aa, 3) + B(bb, 3) + C(cc, 3) + D(dd, 3) + E(ee, 3) + F(ff, 3)
                            If s2 > mem2 Then
                                i = 0
                                ReDim liste(0): ReDim mem1(0)
                                liste(0) = A(aa, 1) & "-" & B(bb, 1) & "-" & C(cc, 1) & "-" & D(dd, 1) & "-" & E(ee, 1) & "-" & F(ff, 1)
                                mem1(0) = s1
                                mem2 = s2
                            ElseIf s2 = mem2 Then
                                i = i + 1
                                ReDim Preserve liste(i): ReDim Preserve mem1(i)
                                liste(i) = A(aa, 1) & "-" & B(bb, 1) & "-" & C(cc, 1) & "-" & D(dd, 1) & "-" & E(ee, 1) & "-" & F(ff, 1)
                                mem1(i) = s1
                            End If
                        End If
Next ff, ee, dd, cc, bb, aa
'---restitution---
Application.ScreenUpdating = False
[K1].Resize(3, Columns.Count - 10).Delete xlToLeft
[G1:J3] = ""
If liste(0) = "" Then Exit Sub
For i = 0 To UBound(liste)
    [G1:J3].Copy [G1].Offset(, 4 * i)
    [G1].Offset(, 4 * i) = liste(i)
    [G2].Offset(, 4 * i) = mem1(i)
    [G3].Offset(, 4 * i) = mem2
Next i
End Sub

Les variables liste et mem1 sont maintenant des variables tableaux (Array).

 

[cotignac]

Génial merci!