Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Solver to match set elements - does it work with big numbers?
Hello,
I'm using this solver code(found publicly on the web, thanks to Gary's Student (I believe:-) ), and it works miracles; but, now I'd like to use it for big numbers up to 30 bytes in size and I can't seem to make it work; as I am not too great a VBA programmer, I'd like someone to check to see if the code is ready for such big numbers and if not, what can I do to make it so? The code can be found below. Any hlep would be GREEATLY appreciated!!! ================================================== = 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 Function Sub startSearch() 'The selection should be a single contiguous range in a single column. _ The first cell indicates the number of solutions wanted. Specify zero for all. _ The 2nd cell is the target value. _ The rest of the cells are the values available for matching. _ The output is in the column adjacent to the one containing the input data. Dim TargetVal, Rslt(), InArr(), StartTime As Date, MaxSoln As Integer StartTime = Now() MaxSoln = Selection.Cells(1).Value TargetVal = Selection.Cells(2).Value InArr = Application.WorksheetFunction.Transpose( _ Selection.Offset(2, 0).Resize(Selection.Rows.Count - 2).Value) ReDim Rslt(0) recursiveMatch MaxSoln, TargetVal, InArr, LBound(InArr), 0, 0.00000001, _ Rslt, "", ", " Rslt(UBound(Rslt)) = Format(Now, "hh:mm:ss") ReDim Preserve Rslt(UBound(Rslt) + 1) Rslt(UBound(Rslt)) = Format(StartTime, "hh:mm:ss") Selection.Offset(0, 1).Resize(ArrLen(Rslt), 1).Value = _ Application.WorksheetFunction.Transpose(Rslt) End Sub ================================================== = The code works like this: make a selection of cells set up as indicated in the code, then run 'startSearch'. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
SOLVER does not iterate / work | Excel Discussion (Misc queries) | |||
Solver to match set elements - does it work with biiig numbers? | Excel Programming | |||
I need to install the solver add-in but my setup CD doesn't work. | Setting up and Configuration of Excel | |||
Solver does not work from Macros | Setting up and Configuration of Excel | |||
How do I get Solver to work | Excel Discussion (Misc queries) |