here is some one how explains how it works
Option Base 1 Sub FinishADartLeg(number As Integer, ThrowsToDo As Integer) ' ______________________________________________________________________________ ' | | ' | Wim Gielis | ' |
[email protected] | ' | 01/20/2007 | ' | Custom module to list the combinations in which a given points total | ' | can be finished in darts, depending on number of throws | ' | Also on
http://www.wimgielis.be | ' |______________________________________________________________________________| 'main procedure Dim arrBoard(63, 2) As Variant, lCounterBoard1 As Long, lCounterBoard2 As Long, lCounterBoard3 As Long Dim iLastThrow As Integer, sFunctionLastThrow As String Dim arrPossib() As Variant, lCounterPossib As Long Dim i As Integer, j As Integer, a As Integer, q As Integer If ThrowsToDo < 1 Or ThrowsToDo > 3 Or Int(ThrowsToDo) <> ThrowsToDo Then MsgBox "You may have only 1, 2 or 3 darts to use.", vbCritical + vbOKOnly, "WARNING" Exit Sub End If Application.ScreenUpdating = False Rows("2:10000").ClearContents 'read in possible outcomes of 1 dart For i = 1 To 20 For j = 1 To 3 arrBoard(i + 20 * (j - 1), 1) = i * j arrBoard(i + 20 * (j - 1), 2) = Choose(j, "", "D ", "T ") & i Next j Next i arrBoard(61, 1) = 25: arrBoard(61, 2) = "bull" arrBoard(62, 1) = 50: arrBoard(62, 2) = "bull's eye" arrBoard(63, 1) = 0: arrBoard(63, 2) = "nothing" 'main loop(s) lCounterPossib = 0 For q = 1 To ThrowsToDo If CanYouFinish(number, q) Then For lCounterBoard1 = LBound(arrBoard, 1) To UBound(arrBoard, 1) For lCounterBoard2 = LBound(arrBoard, 1) To Choose(q, LBound(arrBoard, 1), UBound(arrBoard, 1), UBound(arrBoard, 1)) For lCounterBoard3 = LBound(arrBoard, 1) To Choose(q, LBound(arrBoard, 1), LBound(arrBoard, 1), UBound(arrBoard, 1)) If arrBoard(lCounterBoard1, 1) + IIf(q > 1, arrBoard(lCounterBoard2, 1), 0) + _ IIf(q > 2, arrBoard(lCounterBoard3, 1), 0) = number Then 'check if last is not a 0 and also a double to finish a leg iLastThrow = arrBoard(Choose(q, lCounterBoard1, lCounterBoard2, lCounterBoard3), 1) sFunctionLastThrow = arrBoard(Choose(q, lCounterBoard1, lCounterBoard2, lCounterBoard3), 2) If iLastThrow > 0 And Left(sFunctionLastThrow, 1) = "D" Or sFunctionLastThrow = "bull's eye" Then 'append to the already existing combinations lCounterPossib = lCounterPossib + 1 ReDim Preserve arrPossib(4, lCounterPossib) arrPossib(1, lCounterPossib) = q For a = 1 To q arrPossib(a + 1, lCounterPossib) = _ arrBoard(Choose(a, lCounterBoard1, lCounterBoard2, lCounterBoard3), 2) Next a For a = q + 1 To 3 arrPossib(a + 1, lCounterPossib) = "" Next a End If End If Next lCounterBoard3 Next lCounterBoard2 Next lCounterBoard1 End If Next q 'output to sheet If lCounterPossib > 0 Then Range("E2").Resize(lCounterPossib, 4) = WorksheetFunction.Transpose(arrPossib) Else: MsgBox "It is not possible to finish this leg with " & ThrowsToDo & " dart" & IIf(ThrowsToDo = 1, "", "s") & _ " and still " & number & " on the board.", vbCritical + vbOKOnly, "WARNING" End If Application.ScreenUpdating = True End Sub Function CanYouFinish(Score As Integer, Throws As Integer) As Boolean 'custom function giving TRUE if you can finish "Score" points using at max "Throws" darts, FALSE if not Dim arrFinishIsPossible(1 To 3) As Variant, l As Long CanYouFinish = False If Score < 2 Or Score > 170 Or Throws < 1 Or Throws > 3 Then Exit Function arrFinishIsPossible(1) = Array(2, 4, 6, 8, 10, 12, 14, 16, 18, 20, 22, 24, 26, 28, 30, 32, 34, 36, 38, 40, 50) If Throws > 1 Then arrFinishIsPossible(2) = Array(2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, _ 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, _ 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, _ 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, _ 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 100, 101, 104, 107, 110) End If If Throws > 2 Then arrFinishIsPossible(3) = Array(2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, _ 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, _ 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, _ 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, _ 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, 101, 102, 103, 104, _ 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, _ 122, 123, 124, 125, 126, 127, 128, 129, 130, 131, 132, 133, 134, 135, 136, 137, 138, _ 139, 140, 141, 142, 143, 144, 145, 146, 147, 148, 149, 150, 151, 152, 153, 154, 155, _ 156, 157, 158, 160, 161, 164, 167, 170) End If l = 1 Do If arrFinishIsPossible(Throws)(l) = Score Then CanYouFinish = True Exit Function Else: l = l + 1 End If Loop Until l > UBound(arrFinishIsPossible(Throws)) End Function
