vicktor schausberger writes:
Zen Archery
In his book Wonders of Numbers (Oxford: Oxford University Press, 2001), pp. 275-276, Clifford Pickover posed a "Zen Archery" problem. In its simplest form, there is a target with 24 numbers on it. The archer must shoot 5 arrows at the target and hit numbers adding up to 200. The 24 numbers on the target are
97,101,139,41,37,31,29,89,23,19,8,13,
131,19,73,97,19,139,79,67,61,17,113,127
Pickover posed a similar problem at Archery by the Numbers. This is really a combinatorial problem -- given the 24 numbers taken 5 at a time, which unique combinations add up to 200?
There is some quick and dirty Java code on the Web, associated with Pickover's book, which solves the Zen archery problem for the 24 numbers given. However, it is not exactly a model of good programming, and it even assumes some foreknowledge of the answer in the code, i.e. the fact that all combinations adding up to 200 include the number 8.

Answer:

The text above seems to be copied from this website: http://www.merriampark.com/comb.htm

Let´s create a user defined function that checks every combination and filters values where the sum is equal to 200.

I don´t understand why 19 occurs twice in the 24 numbers on the target. Because of this, the udf returns duplicate rows, therefore some combinations are not unique.

User defined function

Function SumComb(sum As Range, rng As Variant, num As Integer)
Dim Arr(), i, Ans As Single
Dim svVal() As Variant
Dim tmp As Variant
ReDim Arr(num - 1)
ReDim svVal(num - 1, 0)

rng = rng.Value

For i = 0 To num - 1
    Arr(i) = i + 1
Next i

Comb = Application.WorksheetFunction.Combin(UBound(rng, 1), num)

For j = 1 To Comb

    tmp = 0

    For i = 0 To num - 1
        tmp = tmp + rng(Arr(i), 1)
    Next i

    If tmp = sum Then
        For i = 0 To num - 1
            svVal(i, UBound(svVal, 2)) = rng(Arr(i), 1)
        Next i
        ReDim Preserve svVal(UBound(svVal, 1), UBound(svVal, 2) + 1)
    End If

    Arr(num - 1) = Arr(num - 1) + 1

    k = num

    For i = num - 1 To 0 Step -1
        If Arr(i) = UBound(rng, 1) - num + i + 2 Then
            k = i
            Arr(i - 1) = Arr(i - 1) + 1
        Else
            If k <> 0 Then
                k = i
            Else
                k = num
            End If
            Exit For
        End If
    Next i

    If k <> num Then
        For i = k To num - 2
            Arr(i + 1) = Arr(i) + 1
        Next i
    End If

Next j

ReDim Preserve svVal(UBound(svVal, 1), UBound(svVal, 2) - 1)
SumComb = Application.Transpose(svVal)

End Function

 

Where to copy udf?

Press Alt+F11

Explaining user defined function

 

How to enter array formula

 

Download excel 2007 *.xlsm file 

zen archery.xlsm