AW: Kendall's Tau - Erweiterung
26.10.2006 11:33:43
ingUR
Hallo, Florian,
hier noch die Erweiterung mit/ohne Ranggleichheit in der Rangliste 2 (nicht jedoch in der sortierten ersten Datenspalte!) - Programmcode ohne umfassende Prüfungsphase, daher unter Vorbehalt:
Option Explicit
Sub KendallTau()
Dim ws As Worksheet
Dim maxN As Integer, i As Integer, k As Integer
Dim data2, refR As Integer
Dim proversion As Integer, inversion As Integer, tie As Integer, Ktau As Single
Set ws = Worksheets("Tabelle1")
With ws
maxN = .Cells(.Rows.Count, 1).End(xlUp).Row - 1
data2 = .Range("B2:B" & maxN + 1)
'Wertepaar-Auswertung
For i = 1 To maxN - 1
refR = data2(i, 1)
For k = i + 1 To maxN
If refR < data2(k, 1) Then
proversion = proversion + 1
Else
If refR > data2(k, 1) Then
inversion = inversion + 1
Else
tie = tie + 1
End If
End If
Next k
Next i
'Ktau = 2 * (proversion - inversion) / (maxN * (maxN - 1))
Ktau = (proversion - inversion) / Sqr((proversion + inversion) * (proversion + inversion + tie))
.Cells(1, 3) = "Kendall Tau"
.Cells(2, 3) = Ktau
.Cells(3, 4) = proversion
.Cells(4, 4) = inversion
.Cells(5, 4) = tie
End With
Set ws = Nothing
End Sub
Gruß!