Median of all combinations

[Andreas]

Hi,

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

 

[graefe.andreas]

I'd like to edit my post. I found out that the problem is not the
median calculation. It seems as if the ordering function (Sort) does
not work properly. I got the function from here:
http://www.anthony-vba.kefra.com/vba/excelvba-simulation.htm#Sorting_Numbers_In_an_Array

However, in my output file (list all combinations of 3), the output is
not ordered.

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)


For i = 1 To m
sOut = sOut & r(ai(i)).Text & ","
Next i
Write #iFF, Left(sOut, Len(sOut) - 1)
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