请教大侠指点 一二怎么快速找出不同班级中相同成绩的个数大于总

'假设A列有序
Option Explicit
Sub abc()
　Dim i, j, a, p, d, key
　[b:b].Interior.ColorIndex = xlNone
　a = [a1].CurrentRegion.Offset(1).Resize(, 2).Value
　Set d = CreateObject("scripting.dictionary")
　For i = 1 To UBound(a) - 1
　　d(a(i, 2)) = d(a(i, 2)) + 1
　　If a(i, 1) <> a(i + 1, 1) Then
　　　For Each key In d.keys
　　　　If d(key) > (i - p) / 2 Then
　　　　　For j = p + 1 To i
　　　　　　If a(j, 2) = key Then Cells(j + 1, 2).Interior.Color = vbYellow
　　　　　Next
　　　　　Exit For
　　　　End If
　　　Next
　　　p = i: d.RemoveAll
　　End If
　Next
End Sub