Option Base 1
Sub MannWhineyUtest()
Rem computes MannWhineyU test with normal approximation
Dim i, j, k, n, n1, n2, n3, n4, nT1, nT2 As Integer
Dim sumR1, sumR2, U1, U2, U, zScore As Double
Dim Arr1() As Variant
Dim Arr2() As Variant
Dim totalData() As Double
Dim PosR() As Variant
Dim Lwyst() As Variant
Dim PosRadj() As Double
On Error Resume Next
Set RangeN1 = Application.InputBox(Prompt:="Select one-dimensional range with sample 1", _
Title:="Sample 1", Type:=8)
If (RangeN1 Is Nothing) Then
MsgBox "Error no data in 'sample 1'."
Exit Sub
End If
Arr1 = RangeN1.Value
n1 = UBound(Arr1, 1)
n2 = UBound(Arr1, 2)
Set RangeN2 = Application.InputBox(Prompt:="Select one-dimensional range with sample 2", _
Title:="Sample 1", Type:=8)
If (RangeN2 Is Nothing) Then
MsgBox "Error no data in 'sample 2'."
Exit Sub
End If
Arr2 = RangeN2.Value
n3 = UBound(Arr2, 1)
n4 = UBound(Arr2, 2)
n = n1 * n2 + n3 * n4
ReDim totalData(n)
ReDim PosR(n)
ReDim Lwyst(n)
ReDim PosRadj(n)
For i = 1 To n1
For j = 1 To n2
totalData((i - 1) * n2 + j) = Arr1(i, j)
Next j
Next i
For i = 1 To n3
For j = 1 To n4
totalData(n1 * n2 + (i - 1) * n4 + j) = Arr2(i, j)
Next j
Next i
PosR = rank_it(totalData)
For i = 1 To n
For j = 1 To n
If PosR(i) = PosR(j) Then
Lwyst(i) = Lwyst(i) + 1
End If
Next j
Next i
For i = 1 To n
PosRadj(i) = (PosR(i) + (PosR(i) + Lwyst(i) - 1)) / 2
Next i
sumR1 = 0
For i = 1 To n1 * n2
sumR1 = sumR1 + PosRadj(i)
Next i
sumR2 = 0
For i = n1 * n2 + 1 To n
sumR2 = sumR2 + PosRadj(i)
Next i
nT1 = n1 * n2
nT2 = n3 * n4
U1 = nT1 * nT2 + nT1 * (nT1 + 1) / 2 - sumR1
U2 = nT1 * nT2 + nT2 * (nT2 + 1) / 2 - sumR2
U = WorksheetFunction.Min(U1, U2)
zScore = (U - nT1 * nT2 / 2) / (((nT1 * nT2 * (nT1 + nT2 + 1)) / 12) ^ 0.5)
If Round(WorksheetFunction.NormSDist(zScore) * 2, 4) < 0.0001 Then
pValue = "P < 0,0001"
Else
pValue = "P = " & Round(WorksheetFunction.NormSDist(zScore) * 2, 4)
End If
MsgBox pValue & vbCrLf & "U = " & Round(U, 4)
End Sub
Private Function rank_it(arr() As Double)
n = UBound(arr) - LBound(arr) + 1
ReDim V(n)
For i = 1 To n
For j = 1 To n
If arr(i) = WorksheetFunction.Small(arr, j) Then
V(i) = j
Exit For
End If
Next j
Next i
rank_it = V
End Function