A

#### Andreas

I have 5 numbers (can be with decimals) in column A (A1:A5). For these

numbers, I want all combinations as well as the median of these

combinations.

I'm pretty far already. However, the median seems to be calculated

wrong.

Who can help me?

Thanks,

Andreas

Sub test()

ListCombos Range("A1:A5"), 3, "C:\Q1_3er.csv"

End Sub

Sub ListCombos(r As Range, ByVal m As Long, sFile As String)

' lists the combinations of r choose m to file sFile

' r is a single-column or single-row range

Dim ai() As Long

Dim i As Long

Dim n As Long

Dim sOut As String

Dim sOutMedian As String

Dim iFF As Integer

If r Is Nothing Then Exit Sub

If r.Rows.Count <> 1 And r.Columns.Count <> 1 Then Exit Sub

n = r.Count

If m < 1 Then Exit Sub

If m > n Then m = n

iFF = FreeFile

Open sFile For Output As #iFF

ReDim ai(1 To m)

ai(1) = 0

For i = 2 To m

ai(i) = i

Next i

Do

For i = 1 To m - 1

If ai(i) + 1 < ai(i + 1) Then

ai(i) = ai(i) + 1

Exit For

Else

ai(i) = i

End If

Next i

If i = m Then

If ai(m) < n Then

ai(m) = ai(m) + 1

Else

Exit Do

End If

End If

' catenate and write to file

sOut = vbNullString

Call Sort(ai)

sOutMedian = median(ai)

For i = 1 To m

sOut = sOut & r(ai(i)).Text & ","

Next i

Write #iFF, Left(sOut, Len(sOut) - 1), sOutMedian

Loop

Close #iFF

End Sub

Sub Sort(Arr() As Long)

Dim Temp As Double

Dim i As Long

Dim j As Long

For j = 2 To UBound(Arr)

Temp = Arr(j)

For i = j - 1 To 1 Step -1

If (Arr(i) <= Temp) Then GoTo 10

Arr(i + 1) = Arr(i)

Next i

i = 0

10 Arr(i + 1) = Temp

Next j

End Sub

Function median(Arr() As Long)

Call Sort(Arr)

If UBound(Arr) Mod 2 = 1 Then

median = Arr(Int(UBound(Arr) / 2) + 1)

Else

median = (Arr(UBound(Arr) / 2) + Arr(Int(UBound(Arr) / 2) +

1)) / 2

End If

End Function