Autres Petit defi du jour

[patricktoulon]

Bonjour a tous
Un petit défi comme ca le dimanche (et oui c'est tout moi ca )

J’ai plusieurs longueurs en nombre variable
Je cherche un algo qui me permettrait de faire des groupes de longueurs au plus proches les une des autres.
exemple
10;17.5;18;24.9;12.3;32;19;28.7;41;etc.....
ce nombre de longueurs je veux pouvoir le diviser par 3,4,ou,5,ect....groupe

ca me fera x groupes
l'addition des longueurs de ces groupes doivent être = ou tres proche

des idées ?
Patrick

 

[laurent950]

Bonjour @patricktoulon

Quelques choses comme cela ? un début d'idée

 

[patricktoulon]

Bonjour Laurent
En vba stp pas de formule
C’est pour mon algo N°2 du patchwork pour créer une autre méthode

 

[laurent950]

Bonjour @patricktoulon

pour comprendre le mécanisme avec Formule dans un premier temps
je pense que je me suis rapproché de l'écart entre le groupe 1 et Groupe 2
regarde ensuite en VBA c'est simple de faire le code

 

[patricktoulon]

Le raisonnement par formule ne me sera d'aucune utilité. Le problème que j'ai posé constitue une base, mais le contexte est bien différent.
par vba
je dois pouvoir mettre un nom a chaque item de groupe

 

[mapomme]

Bonsoir @patricktoulon😀, et à tous😉,

@patricktoulon :

Chaque groupe doit-il avoir le même d'événements ? (si oui, il faut que le nombre de groupe soit un diviseur du nombre de valeurs).

 

[job75]

Bonjour Patrick, le forum,

Voici une macro qui recherche la solution à partir de tirages aléatoires :

Sub Tirages()
Dim t, Ntirages&, N&, Ngroupes%, source, ecart, tirage&, dest(), i&, j%, mini, maxi, s, copiedest()
t = Timer
Ntirages = 10000 'modifiable
N = Application.Count(Columns(2)) 'il ne faut pas de cellules vides
Ngroupes = [E1] 'liste de validation
source = [B2].Resize(N, 2) 'tableau, plus rapide, au moins 2 éléments
ecart = 1E+99
For tirage = 1 To Ntirages
    ReDim dest(1 To N, 1 To Ngroupes) 'RAZ
    For i = 1 To N
        j = Application.RandBetween(1, Ngroupes)
        dest(i, j) = source(i, 1)
    Next i
    mini = 1E+99
    maxi = 0
    For j = 1 To Ngroupes
        s = Application.Sum(Application.Index(dest, 0, j))
        If s < mini Then mini = s
        If s > maxi Then maxi = s
    Next j
    If maxi - mini < ecart Then ecart = maxi - mini: copiedest = dest
Next tirage
'---restitution et mise en forme---
Application.ScreenUpdating = False
[F2].Resize(Rows.Count - 1, Columns.Count - 5).Delete xlUp 'RAZ
[G2].Resize(N, Ngroupes) = copiedest
With [G2].Offset(N)
    .Offset(-1, -1) = "ECART"
    .Offset(, -1) = ecart
    .Resize(, Ngroupes) = "=SUM(R2C:R[-1]C)"
    .Offset(, -1).Interior.Color = vbCyan
    .Resize(, Ngroupes).Interior.Color = vbYellow
    .Offset(, -1).Resize(, Ngroupes + 1).Borders.Weight = xlHairline
End With
With ActiveSheet.UsedRange: End With 'actualise les barres de défilement
Application.ScreenUpdating = True
MsgBox Format(Ntirages, "#,##0") & " tirages réalisés en " & Format(Timer - t, "0.00 \sec"), , "Tirages"
End Sub

Les en-têtes de colonnes des groupes sont créées par les formules en G1: P1.

A+