# VBA实例：高考分数投档指数分析（数据准备：计算线差；计算省排名）

```‘当前页：ThisWorkbook.Worksheets("院校投档分数线") Sub 计算线差() Dim I%, years\$ Dim rng As range years = InputBox("请输入处理年份：", "年份", "") If years <= ThisWorkbook.Worksheets("备选院校").[B2] Then [j1] = "处理条数：" I = 1 For Each rng In ThisWorkbook.Worksheets("院校投档分数线").range("B2", [B2].End(xlDown)) If rng = "" Then Exit For ElseIf rng = years Then If rng(1, 7) <> "" And I = 1 Then MsgBox "数据已生成！" Exit Sub End If I = 0 If rng(1, 2) = "本科一批院校A段" Or rng(1, 2) = "本科二批院校A段" Then rng(1, 7) = 查排名(Int(rng(1, 6)), rng, rng(1, 4)) rng(1, 8) = Int(rng(1, 6) - 查投档线(rng(1, 2), rng, rng(1, 4))) End If [k1] = rng.Row [l1] = rng(1, 5) End If Next rng MsgBox "处理完毕！" Else MsgBox "请输入正确年份！" End If End Sub```
``````
‘当前页：ThisWorkbook.Worksheets("院校分专业入取线")
Sub 计算排名()
Dim I%, years\$
Dim rng As range
years = InputBox("请输入处理年份：", "年份", "")
If years <= ThisWorkbook.Worksheets("备选院校").[B2] Then
[N1] = "处理条数："
I = 1
For Each rng In ThisWorkbook.Worksheets("院校分专业入取线").range("B2", [B2].End(xlDown))
If rng = "" Then
Exit For
ElseIf rng = years Then
If rng(1, 9) <> "" And I = 1 Then
MsgBox "数据已生成！"
Exit Sub
End If
I = 0
If rng(1, 3) = "本科一批院校A段" Or rng(1, 3) = "本科二批院校A段" Then
fc = 查投档线(rng(1, 3), rng, rng(1, 2))
rng(1, 9) = 查排名(rng(1, 7), rng, rng(1, 2))
rng(1, 10) = 查排名(rng(1, 8), rng, rng(1, 2))
rng(1, 11) = rng(1, 7) - fc
rng(1, 12) = rng(1, 8) - fc
End If
End If
[O1] = rng.Row
[P1] = rng(1, 5)
Next rng
MsgBox "处理完毕！"
Else
MsgBox "请输入正确年份！"
End If
End Sub``````

VBA实例：高考分数投档指数分析（数据准备：计算线差；计算省排名）

(0)
(0) 