XL 2013 Trouver le résultat le plus proche et maximisant le nombre de lignes prises

[HELCOU]

Bonjour,

J'ai fait de mon mieux pour le titre mais pas certaines que ce soit très clair.

En fait, je dois faire des compensations comptables. J'ai deux colonnes de chiffres avec un solde différent. Le solde 1 (somme colonne 1) est plus petit que le solde 2 (somme colonne 2).
Je voudrais:
Solde 1 = somme du maximum de ligne dans la colonne 2 tout minimisant l'écart le plus possible.


D'avance merci! Si vous avez un conseil pour améliorer le titre aussi n'hésitez pas.

Hélène

 

[job75]

Re : Trouver le résultat le plus proche et maximisant le nombre de lignes prises

Bonjour HELCOU,

Pourquoi courir plusieurs lièvres à la fois ?

Si le but est de minimiser l'écart vous pouvez procéder par tirages aléatoires :

- entrez en G4 et tirez vers le bas la formule =(ALEA()>0,5)*E4

- entrez en G73 et tirez sur H73 =ABS(SOMME(G4:G71)-$C73)

- cliquez sur le bouton pour lancer cette macro :

Sub Tirages()
Dim mini, i&, tablo
mini = [G73]
Application.ScreenUpdating = False
For i = 1 To 100000 'nombre d'itérations à adapter
  Calculate
  If [G73] < mini Then mini = [G73]: tablo = [G4:G71]
Next
[H4:H71] = tablo
MsgBox "Ecart " & mini
End Sub

Sans difficulté je suis arrivé à un écart de 9,5 en H73.

Edit : mieux, écart de 3,23, record à battre

Fichier joint.

A+

 

[job75]

Re : Trouver le résultat le plus proche et maximisant le nombre de lignes prises

Re,

Fichier (2) avec écart 1,68.

A+

 

[job75]

Re : Trouver le résultat le plus proche et maximisant le nombre de lignes prises

Re,

Avec cette macro plus besoin de la fonction ALEA() dans la feuille :

Sub Tirages()
Dim cible, mini, t, ub, a, i&, j&, x, b
cible = [C73]
mini = [E73] - cible
t = [E4:E71]: ub = UBound(t)
ReDim a(1 To ub)
Randomize
For i = 1 To 1000000 'nombre d'itérations à adapter
  For j = 1 To ub
    a(j) = -(Rnd > 0.5) * t(j, 1)
  Next
  x = Abs(Application.Sum(a) - cible)
  If x < mini Then mini = x: b = a
Next
[G4:G71] = Application.Transpose(b)
MsgBox "Ecart " & mini
End Sub

Comme elle est bien plus rapide on peut utiliser un million d'itérations.

Du 1er coup j'ai obtenu un écart de 0,32.

Fichier (3).

Bonne fin de soirée.

 

[HELCOU]

Re : Trouver le résultat le plus proche et maximisant le nombre de lignes prises

Trop fort!!

Merci,

Hélène

 

[job75]

Re : Trouver le résultat le plus proche et maximisant le nombre de lignes prises

Bonjour HELCOU, le forum,

Application.Sum est un peu lent, ceci fait gagner 1/3 du temps :

Sub Tirages()
Dim tim, cible, mini, t, ub, a, i&, s, j&, b
tim = Timer
cible = [C73]
mini = [E73] - cible
t = [E4:E71]: ub = UBound(t)
ReDim a(1 To ub)
Randomize
For i = 1 To 1000000 'nombre d'itérations à adapter
  s = 0
  For j = 1 To ub
    a(j) = -(Rnd > 0.5) * t(j, 1)
    s = s + a(j)
  Next
  s = Abs(s - cible)
  If s < mini Then mini = s: b = a
Next
[G4:G71] = Application.Transpose(b)
MsgBox "Durée " & Format(Timer - tim, "0.00 \s") & vbLf & "Ecart " & mini
End Sub

Fichier (4).

Bonne journée