Hello guys
I found a very usefull code and I would like your assistance on implement it on limitating the quantity of numbers that will give the desired sum.
For instance I would like the combination of numbers limitating to 13 the set of numbers.
So I will have for each set of numbers 13 numbers as example.
I will choose the quantity of sets and also the quantity of number in each set that will give me as sum result my desired value.
Source:
I found a very usefull code and I would like your assistance on implement it on limitating the quantity of numbers that will give the desired sum.
For instance I would like the combination of numbers limitating to 13 the set of numbers.
So I will have for each set of numbers 13 numbers as example.
I will choose the quantity of sets and also the quantity of number in each set that will give me as sum result my desired value.
Code:
Option Explicit
Function RealEqual(A, B, Epsilon As Double)
RealEqual = Abs(A - B) <= Epsilon
End Function
Function ExtendRslt(CurrRslt, NewVal, Separator)
If CurrRslt = "" Then ExtendRslt = NewVal _
Else ExtendRslt = CurrRslt & Separator & NewVal
End Function
Sub recursiveMatch(ByVal MaxSoln As Integer, ByVal TargetVal, InArr(), _
ByVal CurrIdx As Integer, _
ByVal CurrTotal, ByVal Epsilon As Double, _
ByRef Rslt(), ByVal CurrRslt As String, ByVal Separator As String)
Dim I As Integer
For I = CurrIdx To UBound(InArr)
If RealEqual(CurrTotal + InArr(I), TargetVal, Epsilon) Then
Rslt(UBound(Rslt)) = (CurrTotal + InArr(I)) _
& Separator & Format(Now(), "hh:mm:ss") _
& Separator & ExtendRslt(CurrRslt, I, Separator)
If MaxSoln = 0 Then
If UBound(Rslt) Mod 100 = 0 Then Debug.Print UBound(Rslt) & "=" & Rslt(UBound(Rslt))
Else
If UBound(Rslt) >= MaxSoln Then Exit Sub
End If
ReDim Preserve Rslt(UBound(Rslt) + 1)
ElseIf CurrTotal + InArr(I) > TargetVal + Epsilon Then
ElseIf CurrIdx < UBound(InArr) Then
recursiveMatch MaxSoln, TargetVal, InArr(), I + 1, _
CurrTotal + InArr(I), Epsilon, Rslt(), _
ExtendRslt(CurrRslt, I, Separator), _
Separator
If MaxSoln <> 0 Then If UBound(Rslt) >= MaxSoln Then Exit Sub
Else
'we've run out of possible elements and we _
still don 't have a match
End If
Next I
End Sub
Function ArrLen(Arr()) As Integer
On Error Resume Next
ArrLen = UBound(Arr) - LBound(Arr) + 1
End FunctionSource:
HTML:
http://www.tushar-mehta.com/excel/templates/match_values/
