View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
[email protected] graefe.andreas@gmail.com is offline
external usenet poster
 
Posts: 7
Default Median of all combinations

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 he
http://www.anthony-vba.kefra.com/vba...rs_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