Witam.
Swojego czasu napisałem podobną funkcję na własne potrzeby (inspiracją było jakieś forum :) ).

Funkcja zwraca tablicę wyników, więc należy ją wprowadzić do arkusza jako tablicową.

Przykład:
Wybierane liczby do sumy są w zakresie A1:A30
W B2 wpisujemy liczbę - porzebną sumę.
Zaznaczmy zakres C2:E2 i wprowadzamy formułę:
=LiczbyDoSumy(A1:A30;B2;1)
którą zatwierdzamy klawiszem Enter poczas trzymania wciśniętych klawiszy Ctrl i Shift.
Otrzymamy 3 liczby wybrane do sumy.
Jeśli wynik składa się tylko z jednej liczby, to dwie pozostałe będą równe zero. Dla wyniku w postaci pary liczb, trzecia liczba =0.

lub/oraz
zaznaczmy zakres C6:C8 i wprowadzamy formułę
=LiczbyDoSumy(A1:A50;B2;2)
otrzymamy 3 elementową listę 'pozycji' w przeszukiwanym zakresie liczb wziętych do sumy.
Może to być przydatne w celu np. wybrania numeru faktury gdy przeszukujemy kolumnę wartości faktur.

Nie jest problemem rozszerzenie wyników do czterech czy więcej liczb, lecz VBA jest jezykiem interpretowanym, przez co wolnym i obliczenia trwają potwornie długo zwlaszcza, gdy zakres przeszukiwany jest duży.

Function LiczbyDoSumy(zakres As Range, _
                      suma As Range, _
                      Optional rodzaj_wyniku = 2) As Variant

' (c)14.04.2006 Ryszard Gardziejewski
'
' Parametry:
'    zakres - zakres liczb wybieranych do sumy
'    suma   - oczekiwana (wymagana) suma liczb
'    rodzaj_wyniku (opcjonalnie)
'         =1 dla wyniku w postaci wyszukanych liczb
'         =2 dla wyniku w postaci położenia (indeksu) w zakresie (domyślnie)
'
' Z wskazanego zakresu, funkcja zwraca maksymalnie 3 liczby (lub ich położenie
' w zakresie), których suma jest najbardziej zbliżona do sumy wymaganej.
'
' Jeżeli jest kilka rozwiązań dokładnych, funkcja zwaca pierwszy ten, który wymaga
' najmniej liczb.
'
' Funkcja zawsze zwraca tablicę 3 wyników; należy ją stosować wyłącznie jako tablicową.
'
'
  Dim Z, L As Double
  Dim il As Integer, i As Integer, j As Integer, k As Integer
  Dim min As Double, a As Double
  Dim Tw(1 To 3) As Double
 
  Z = zakres.Value
  L = suma.Value
  min = 1E+308
 
  'sprawdzenie dla jednej liczby wyniku
  For i = 1 To UBound(Z)
      a = Abs(L - Z(i, 1))
      If a < min Then
        min = a
        Tw(1) = i
      End If
  Next i
 
  'dla 2 liczb wyniku
  For i = 1 To UBound(Z) - 1
    For j = i + 1 To UBound(Z)
      a = Abs(L - Z(i, 1) - Z(j, 1))
      If a < min Then
        min = a
        Tw(1) = i
        Tw(2) = j
      End If
    Next j
  Next i
 
  'dla 3 liczb wyniku
  For i = 1 To UBound(Z) - 2
    For j = i + 1 To UBound(Z) - 1
      For k = j + 1 To UBound(Z)
        a = Abs(L - Z(i, 1) - Z(j, 1) - Z(k, 1))
        If a < min Then
          min = a
          Tw(1) = i
          Tw(2) = j
          Tw(3) = k
        End If
      Next k
    Next j
  Next i
 
  If rodzaj_wyniku = 1 Then
    Tw(1) = Z(Tw(1), 1)
    If Tw(2) > 0 Then Tw(2) = Z(Tw(2), 1)
    If Tw(3) > 0 Then Tw(3) = Z(Tw(3), 1)
  End If
 
  'czy funkcja jest wprowadzona do pionowego zakresu
  If Application.Caller.Columns.Count = 1 Then
    LiczbyDoSumy = WorksheetFunction.Transpose(Tw)
  Else
    LiczbyDoSumy = Tw
  End If

End Function