Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
Help!!!
I have a set of 24 #'s. is there an easy way(*formula) to tell me the
combination of those #'s to equal a given #? Example( my set of numbers are 1,2,3,4,5 etc..) i need to know a combination equaling to 10. and an answer would be 2,3,5. I understand there could be more than one combination but is there any formual that could help me do something like this? |
#2
Posted to microsoft.public.excel.misc
|
|||
|
|||
Help!!!
There is no formula to do that kind of thing... Your example actually has 9
solutions... 10.00 6.00 4.00 7.00 3.00 8.00 2.00 9.00 1.00 5.00 4.00 1.00 5.00 3.00 2.00 6.00 3.00 1.00 7.00 2.00 1.00 Doing this requires code and and little bit of knowledge... Here is the code. To make the references in the VBE (where you write the code) select Tools - References and check off Microsoft Scripting Runtime &Microsoft VBScript Regular Expressions 1.0 Option Explicit 'This *REQUIRES* VBAProject references to 'Microsoft Scripting Runtime 'Microsoft VBScript Regular Expressions 1.0 'Written by Harlan Grove Sub FindSums() Const TOL As Double = 0.000001 'modify as needed Dim c As Variant Dim j As Long, k As Long, n As Long, p As Boolean Dim s As String, t As Double, u As Double Dim v As Variant, x As Variant, y As Variant Dim dc1 As New Dictionary, dc2 As New Dictionary Dim dcn As Dictionary, dco As Dictionary Dim re As New RegExp re.Global = True re.IgnoreCase = True On Error Resume Next Set x = Application.InputBox( _ Prompt:="Enter range of values:", _ Title:="findsums", _ Default:="", _ Type:=8 _ ) If x Is Nothing Then Err.Clear Exit Sub End If y = Application.InputBox( _ Prompt:="Enter target value:", _ Title:="findsums", _ Default:="", _ Type:=1 _ ) If VarType(y) = vbBoolean Then Exit Sub Else t = y End If On Error GoTo 0 Set dco = dc1 Set dcn = dc2 Call recsoln For Each y In x.Value2 If VarType(y) = vbDouble Then If Abs(t - y) < TOL Then recsoln "+" & Format(y) ElseIf dco.Exists(y) Then dco(y) = dco(y) + 1 ElseIf y < t - TOL Then dco.Add Key:=y, Item:=1 c = CDec(c + 1) Application.StatusBar = "[1] " & Format(c) End If End If Next y n = dco.Count ReDim v(1 To n, 1 To 3) For k = 1 To n v(k, 1) = dco.Keys(k - 1) v(k, 2) = dco.Items(k - 1) Next k qsortd v, 1, n For k = n To 1 Step -1 v(k, 3) = v(k, 1) * v(k, 2) + v(IIf(k = n, n, k + 1), 3) If v(k, 3) t Then dcn.Add Key:="+" & Format(v(k, 1)), Item:=v(k, 1) Next k On Error GoTo CleanUp Application.EnableEvents = False Application.Calculation = xlCalculationManual For k = 2 To n dco.RemoveAll swapo dco, dcn For Each y In dco.Keys p = False For j = 1 To n If v(j, 3) < t - dco(y) - TOL Then Exit For x = v(j, 1) s = "+" & Format(x) If Right(y, Len(s)) = s Then p = True If p Then re.Pattern = "\" & s & "(?=(\+|$))" If re.Execute(y).Count < v(j, 2) Then u = dco(y) + x If Abs(t - u) < TOL Then recsoln y & s ElseIf u < t - TOL Then dcn.Add Key:=y & s, Item:=u c = CDec(c + 1) Application.StatusBar = "[" & Format(k) & "] " & Format(c) End If End If End If Next j Next y If dcn.Count = 0 Then Exit For Next k If (recsoln() = 0) Then _ MsgBox Prompt:="all combinations exhausted", Title:="No Solution" CleanUp: Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic Application.StatusBar = False End Sub Private Function recsoln(Optional s As String) Const OUTPUTWSN As String = "findsums solutions" 'modify to taste Static r As Range Dim ws As Worksheet If s = "" And r Is Nothing Then On Error Resume Next Set ws = ActiveWorkbook.Worksheets(OUTPUTWSN) If ws Is Nothing Then Err.Clear Application.ScreenUpdating = False Set ws = ActiveSheet Set r = Worksheets.Add.Range("A1") r.Parent.Name = OUTPUTWSN ws.Activate Application.ScreenUpdating = False Else ws.Cells.Clear Set r = ws.Range("A1") End If recsoln = 0 ElseIf s = "" Then recsoln = r.Row - 1 Set r = Nothing Else r.Value = s Set r = r.Offset(1, 0) recsoln = r.Row - 1 End If End Function Private Sub qsortd(v As Variant, lft As Long, rgt As Long) 'ad hoc quicksort subroutine 'translated from Aho, Weinberger & Kernighan, '"The Awk Programming Language", page 161 Dim j As Long, pvt As Long If (lft = rgt) Then Exit Sub swap2 v, lft, lft + Int((rgt - lft + 1) * Rnd) pvt = lft For j = lft + 1 To rgt If v(j, 1) v(lft, 1) Then pvt = pvt + 1 swap2 v, pvt, j End If Next j swap2 v, lft, pvt qsortd v, lft, pvt - 1 qsortd v, pvt + 1, rgt End Sub Private Sub swap2(v As Variant, i As Long, j As Long) 'modified version of the swap procedure from 'translated from Aho, Weinberger & Kernighan, '"The Awk Programming Language", page 161 Dim t As Variant, k As Long For k = LBound(v, 2) To UBound(v, 2) t = v(i, k) v(i, k) = v(j, k) v(j, k) = t Next k End Sub Private Sub swapo(a As Object, b As Object) Dim t As Object Set t = a Set a = b Set b = t End Sub '---- end VBA code ---- -- HTH... Jim Thomlinson "Yoink!" wrote: I have a set of 24 #'s. is there an easy way(*formula) to tell me the combination of those #'s to equal a given #? Example( my set of numbers are 1,2,3,4,5 etc..) i need to know a combination equaling to 10. and an answer would be 2,3,5. I understand there could be more than one combination but is there any formual that could help me do something like this? |
#3
Posted to microsoft.public.excel.misc
|
|||
|
|||
Help!!!
This can be done with formulas. I have done such a thing for a postage
calculator. If desired, send your file to my address below along with this msg and a clear explanation of what you want and before/after examples. -- Don Guillett Microsoft MVP Excel SalesAid Software "Yoink!" wrote in message ... I have a set of 24 #'s. is there an easy way(*formula) to tell me the combination of those #'s to equal a given #? Example( my set of numbers are 1,2,3,4,5 etc..) i need to know a combination equaling to 10. and an answer would be 2,3,5. I understand there could be more than one combination but is there any formual that could help me do something like this? |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|