Sulprobil
Search…
List all combinations which increase average
Suppose you have a row with 9 numbers. The average is always calculated as an integer (rounded down).
Can you list all possible combinations of minimal value increases to reach the next higher average, if you are only allowed to increase numbers up to the current average?
Example:
The sum of input row numbers (row 2) is 42. You need a sum of 45 to get to the next higher average of 5. Since you can only increase numbers up to the current average of 4, you can only change input cells E2 and I2. There are three possible combinations which are listed in rows 10:12. This problem has been stated in a German Excel forum.
Please read my Disclaimer.
1
Sub Combinations()
2
'https://berndplumhoff.gitbook.io/sulprobil/excel/excel-vba-solutions/combinatorial-fun/list-all-combinations-which-increase-average V0.1 29-Jun-2020
3
Dim i As Long, j As Long
4
Dim lCount As Long, lSumTarget As Long, lAvg As Long
5
Dim dAvg As Double
6
Dim v As Variant, vMax As Variant, vMin As Variant
7
8
With Application.WorksheetFunction
9
10
j = 10
11
v = Range(Cells(2, 1), Cells(2, 1).End(xlToRight))
12
lCount = UBound(v, 2) - LBound(v, 2) + 1
13
dAvg = .Average(v)
14
lAvg = .RoundDown(dAvg, 0)
15
lSumTarget = .RoundDown(dAvg + 1#, 0) * lCount
16
17
vMax = v
18
For i = 1 To lCount
19
If vMax(1, i) < lAvg Then vMax(1, i) = lAvg
20
Next i
21
22
vMin = v
23
Range("10:65536").Delete
24
Select Case .Sum(vMax)
25
Case Is < lSumTarget
26
[A10] = "There is no solution."
27
Case Is = lSumTarget
28
Range(Cells(j, 1), Cells(j, lCount)).FormulaArray = vMax
29
Case Else
30
i = 1
31
Do While i <= lCount
32
Do While v(1, i) = vMax(1, i)
33
i = i + 1
34
If i > lCount Then Exit Sub
35
Loop
36
v(1, i) = v(1, i) + 1
37
Do While i > 1
38
i = i - 1
39
v(1, i) = vMin(1, i)
40
Loop
41
If .Sum(v) = lSumTarget Then
42
Range(Cells(j, 1), Cells(j, lCount)).FormulaArray = v
43
j = j + 1
44
End If
45
Loop
46
End Select
47
48
End With
49
50
End Sub
Copied!
Combinations_to_increase_average.xlsm
18KB
Binary
Last modified 1yr ago
Copy link