Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
Mac Mac is offline
external usenet poster
 
Posts: 213
Default Solver to match set elements - does it work with biiig numbers?

Hello,

I'm using this solver (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
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
SOLVER does not iterate / work BHatMJ Excel Discussion (Misc queries) 4 August 12th 09 10:42 PM
I need to install the solver add-in but my setup CD doesn't work. dd Setting up and Configuration of Excel 0 April 29th 06 11:46 PM
Solver does not work from Macros mjd918 Setting up and Configuration of Excel 1 January 6th 06 04:15 PM
How do I get Solver to work Graeme Excel Discussion (Misc queries) 6 September 22nd 05 04:33 AM
Problem getting solver to work in macro dlowie Excel Programming 1 August 26th 05 06:55 PM


All times are GMT +1. The time now is 08:18 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"