# 计算Spearman等级相关系数的VBA函数

ρ=16i=1nΔri2n3n

Function Spearman(Rng1 As Range, Rng2 As Range) As Double
Dim WF As WorksheetFunction
Dim dSquared() As Long
Dim r As Long
Set WF = WorksheetFunction
ReDim Preserve dSquared(1 To Rng1.Cells.Count)

If Rng1.Columns.Count < 2 Then
For r = LBound(dSquared) To UBound(dSquared)
dSquared(r) = (WF.Rank(Rng1.Cells(r, 1), Rng1) - WF.Rank(Rng2.Cells(r, 1), Rng2)) ^ 2
Next r
Else
For r = LBound(dSquared) To UBound(dSquared)
dSquared(r) = (WF.Rank(Rng1.Cells(1, r), Rng1) - WF.Rank(Rng2.Cells(1, r), Rng2)) ^ 2
Next r
End If

Spearman = 1 - ((6 * WF.Sum(dSquared)) / ((Rng1.Cells.Count ^ 3) - Rng1.Cells.Count))
End Function

Function SpearmanAvg(Rng1 As Range, Rng2 As Range) As Double

Dim WF As WorksheetFunction
Dim dSquared() As Double
Dim r As Long
Set WF = WorksheetFunction

ReDim Preserve dSquared(1 To Rng1.Cells.Count)

If Rng1.Columns.Count < 2 Then
For r = LBound(dSquared) To UBound(dSquared)
dSquared(r) = (WF.Rank_Avg(Rng1.Cells(r, 1), Rng1) - WF.Rank_Avg(Rng2.Cells(r, 1), Rng2)) ^ 2
Next r
Else
For r = LBound(dSquared) To UBound(dSquared)
dSquared(r) = (WF.Rank_Avg(Rng1.Cells(1, r), Rng1) - WF.Rank_Avg(Rng2.Cells(1, r), Rng2)) ^ 2
Next r
End If

SpearmanAvg = 1 - ((6 * WF.Sum(dSquared)) / ((Rng1.Cells.Count ^ 3) - Rng1.Cells.Count))
End Function

Function SpearmanEq(Rng1 As Range, Rng2 As Range) As Double
Dim WF As WorksheetFunction
Dim dSquared() As Long
Dim r As Long
Set WF = WorksheetFunction
ReDim Preserve dSquared(1 To Rng1.Cells.Count)

If Rng1.Columns.Count < 2 Then
For r = LBound(dSquared) To UBound(dSquared)
dSquared(r) = (WF.Rank_Eq(Rng1.Cells(r, 1), Rng1) - WF.Rank_Eq(Rng2.Cells(r, 1), Rng2)) ^ 2
Next r
Else
For r = LBound(dSquared) To UBound(dSquared)
dSquared(r) = (WF.Rank_Eq(Rng1.Cells(1, r), Rng1) - WF.Rank_Eq(Rng2.Cells(1, r), Rng2)) ^ 2
Next r
End If

SpearmanEq = 1 - ((6 * WF.Sum(dSquared)) / ((Rng1.Cells.Count ^ 3) - Rng1.Cells.Count))

End Function

Function Spearman(Rng1 As Range, Rng2 As Range) As Double
Dim WF As WorksheetFunction
Dim dSquared() As Long
Dim r As Long
Set WF = WorksheetFunction
ReDim Preserve dSquared(1 To Rng1.Rows.Count)
For r = LBound(dSquared) To UBound(dSquared)
dSquared(r) = (WF.Rank(Rng1.Cells(r, 1), Rng1) - WF.Rank(Rng2.Cells(r, 1), Rng2)) ^ 2
Next r
Spearman = 1 - ((6 * WF.Sum(dSquared)) / ((Rng1.Rows.Count ^ 3) - Rng1.Rows.Count))
End Function

Function SpearmanAvg(Rng1 As Range, Rng2 As Range) As Double
Dim WF As WorksheetFunction
Dim dSquared() As Long
Dim r As Long
Set WF = WorksheetFunction
ReDim Preserve dSquared(1 To Rng1.Rows.Count)
For r = LBound(dSquared) To UBound(dSquared)
dSquared(r) = (WF.Rank_Avg(Rng1.Cells(r, 1), Rng1) - WF.Rank_Avg(Rng2.Cells(r, 1), Rng2)) ^ 2
Next r
SpearmanAvg = 1 - ((6 * WF.Sum(dSquared)) / ((Rng1.Rows.Count ^ 3) - Rng1.Rows.Count))
End Function

Function SpearmanEq(Rng1 As Range, Rng2 As Range) As Double
Dim WF As WorksheetFunction
Dim dSquared() As Long
Dim r As Long
Set WF = WorksheetFunction
ReDim Preserve dSquared(1 To Rng1.Rows.Count)
For r = LBound(dSquared) To UBound(dSquared)
dSquared(r) = (WF.Rank_Eq(Rng1.Cells(r, 1), Rng1) - WF.Rank_Eq(Rng2.Cells(r, 1), Rng2)) ^ 2
Next r
SpearmanEq = 1 - ((6 * WF.Sum(dSquared)) / ((Rng1.Rows.Count ^ 3) - Rng1.Rows.Count))
End Function


• 本文已收录于以下专栏：

## 统计相关系数(2)——Spearman Rank（斯皮尔曼等级）相关系数

1、简介 在统计学中，斯皮尔曼等级相关系数以Charles Spearman命名，并经常用希腊字母ρ（rho）表示其值。斯皮尔曼等级相关系数用来估计两个变量X、Y之间的相关性，其中变量间的相关性可以...
• shuangyufrank
• 2014年12月17日 10:58
• 2222

## 三大统计相关系数：Pearson、Spearman秩相关系数、kendall等级相关系数

• zhaozhn5
• 2017年10月30日 13:48
• 397

## Spearman Rank相关系数计算

spearman相关系数秩相关系数，秩相关系数还有其他类型，比如kendal秩相关系数 -使用Pearson线性相关系数有2个局限： * 1.必须假设数据是成对地从正态分布中取得的。* * 2...
• BabyBirdToFly
• 2017年05月05日 12:04
• 947

## Spearman秩相关系数和Pearson皮尔森相关系数

1、Pearson皮尔森相关系数皮尔森相关系数也叫皮尔森积差相关系数，用来反映两个变量之间相似程度的统计量。或者说用来表示两个向量的相似度。皮尔森相关系数计算公式如下：　　分子是协方差，分母两个向量的...
• u011089523
• 2016年11月03日 17:09
• 1009

## 相关性检验--Spearman秩相关系数和皮尔森相关系数

• promise_LOVE
• 2015年06月08日 11:06
• 3116

## 几个相关系数：Pearson、Spearman、pointbiserialr、kendalltau

• mmc2015
• 2016年07月18日 15:36
• 3576

## [秩相关] Spearman秩相关系数计算及假设检验

• zhaozhn5
• 2017年10月30日 09:59
• 239

## SPSS——相关分析——Spearman秩相关系数

• liuyuan_jq
• 2016年09月14日 23:02
• 13400

## 斯皮尔曼等级相关性-Spearman Rank Correlation

• lhkaikai
• 2014年07月06日 18:11
• 2737