top5问题

Option Explicit
Sub abc()
　Dim a, i, j
　a = [a1].CurrentRegion.Value
　ReDim b(5, (UBound(a, 2) - 1) * 2)
　For j = 2 To UBound(a, 2)
　　Call bsort(a, 3, UBound(a), 1, UBound(a, 2), j)
　　b(0, (j - 1) * 2 - 1) = a(1, j)
　　b(0, (j - 1) * 2) = "数量"
　　For i = 3 To 7
　　　b(i - 2, 0) = i - 2
　　　b(i - 2, (j - 1) * 2 - 1) = a(i, 1)
　　　b(i - 2, (j - 1) * 2) = a(i, j)
　　Next
　Next
　[a3].Offset(, UBound(a, 2) + 1).Resize(UBound(b) + 1, UBound(b, 2) + 1) = b
End Sub
Function bsort(a, first, last, left, right, key)
　Dim i, j, k, t
　For i = first To last - 1
　　For j = first To last + first - 1 - i
　　　If a(j, key) < a(j + 1, key) Then
　　　　For k = left To right
　　　　　t = a(j, k): a(j, k) = a(j + 1, k): a(j + 1, k) = t
　　　　Next
　　　End If
　　Next
　Next
End Function

这是考试的题目吗，如果是日常用我觉得可以在最左侧插入一列排名(rank)，然后vlookup就行了吧，或者用index不想要那一列就隐藏了，或者再拉个工作表作为源数据？我是萌新不知道这样可合规

透视表_排名，筛选top5