Option Explicit
Sub test()
Dim dGoal As Double: dGoal = 213962.43
Dim a() As Variant: a = Range("A4:A386").Value
Dim uvA As Integer: uvA = UBound(a)
Dim vS(1 To 383) As Variant
Dim i, fi, j, k As Integer
Dim mintnow, mint As Double
Dim now As Double
Dim chosen As Integer
Dim luui, luuj, luuk, c As Integer
For i = 1 To uvA
vS(i) = False
Next
For fi = 1 To uvA
now = a(fi, 1)
vS(fi) = True
mintnow = 1000000000000#
Do While True
mint = mintnow
chosen = 0
luui = -1
luuj = -1
luuk = -1
For i = 1 To (uvA - 2)
If Not vS(i) Then
For j = (i + 1) To (uvA - 1)
If Not vS(j) Then
For k = (j + 1) To uvA
If Not vS(k) Then
If Abs(now + a(i, 1) + a(j, 1) + a(k, 1) - dGoal) < mint Then
mint = Abs(now + a(i, 1) + a(j, 1) + a(k, 1) - dGoal)
luui = i
luuj = j
luuk = k
chosen = 3
End If
End If
Next
End If
Next
End If
Next
For i = 1 To uvA
If Not vS(i) Then
If Abs(now + a(i, 1) - dGoal) < mint Then
mint = Abs(now + a(i, 1) - dGoal)
luui = i
chosen = 1
End If
End If
Next
For i = 1 To (uvA - 1)
If Not vS(i) Then
For j = (i + 1) To uvA
If Not vS(j) Then
If Abs(now + a(i, 1) + a(j, 1) - dGoal) < mint Then
mint = Abs(now + a(i, 1) + a(j, 1) - dGoal)
luui = i
luuj = j
chosen = 1
End If
End If
Next
End If
Next
If chosen = 1 Then
now = now + a(luui, 1)
vS(luui) = True
End If
If chosen = 2 Then
now = now + a(luui, 1) + a(luuj, 1)
vS(luui) = True
vS(luuj) = True
End If
If chosen = 3 Then
now = now + a(luui, 1) + a(luuj, 1) + a(luuk, 1)
vS(luui) = True
vS(luuj) = True
vS(luuk) = True
End If
If Abs(now - dGoal) < mintnow Then
mintnow = Abs(now - dGoal)
If mintnow < 0.001 Then
Do While True
Debug.Print "--------------------------------"
Debug.Print "Chosen list:"
c = 0
For i = 1 To uvA
If vS(i) Then
Debug.Print a(i, 1)
c = c + 1
End If
Next
Debug.Print "Total numbers: " & c
Debug.Print "Opt sum: " & now
Debug.Print "Epsilon: " & mintnow
Exit Do
Loop
End If
Else
Exit Do
End If
Loop
Next
End Sub
