VBA查询成绩最低的,成绩相同时，姓名也就同一个人，怎么办？

yuanye2016

Sub 成绩查找()
On Error Resume Next
Dim q As Integer, r As Integer
q = InputBox("请输入要查询成绩最低的人数：")
ReDim 姓名最低(q), 成绩最低(q) As Integer
Cells(1, 15) = "语文后" & q & "名"
For r = 1 To q
成绩最低(r) = Application.WorksheetFunction.Small([B2:B100], r)
姓名最低(r) = Application.WorksheetFunction.Index([A1:A100], _
Application.WorksheetFunction.Match(成绩最低(r), [B1:B100], 0), 1)
Cells(1 + r, 15) = 姓名最低(r)
Cells(1 + r, 16) = 成绩最低(r)
Next r
On Error Resume Next
Dim n As Integer, i As Integer
n = InputBox("请输入要查询成绩最低的人数：")
ReDim 姓名最低(n), 成绩最低(n) As Integer
Cells(1, 17) = "数学后" & n & "名"
For i = 1 To n
成绩最低(i) = Application.WorksheetFunction.Small([C2:C100], i)
姓名最低(i) = Application.WorksheetFunction.Index([A1:A100], _
Application.WorksheetFunction.Match(成绩最低(i), [C1:C100], 0), 1)
Cells(1 + i, 17) = 姓名最低(i)
Cells(1 + i, 18) = 成绩最低(i)
Next i
On Error Resume Next
Dim O As Integer, h As Integer
O = InputBox("请输入要查询成绩最低的人数：")
ReDim 姓名最低(O), 成绩最低(O) As Integer
Cells(1, 19) = "英语后" & O & "名"
For h = 1 To O
成绩最低(h) = Application.WorksheetFunction.Small([D2:D100], h)
姓名最低(h) = Application.WorksheetFunction.Index([A1:A100], _
Application.WorksheetFunction.Match(成绩最低(h), [D1:D100], 0), 1)
Cells(1 + h, 19) = 姓名最低(h)
Cells(1 + h, 20) = 成绩最低(h)
Next h
On Error Resume Next
Dim m As Integer, k As Integer
m = InputBox("请输入要查询成绩最低的人数：")
ReDim 姓名最低(m), 成绩最低(m) As Integer
Cells(1, 21) = "科学后" & m & "名"
For k = 1 To m
成绩最低(k) = Application.WorksheetFunction.Small([E2:E100], k)
姓名最低(k) = Application.WorksheetFunction.Index([A1:A100], _
Application.WorksheetFunction.Match(成绩最低(k), [E1:E100], 0), 1)
Cells(1 + k, 21) = 姓名最低(k)
Cells(1 + k, 22) = 成绩最低(k)
Next k
On Error Resume Next
Dim p As Integer, j As Integer
p = InputBox("请输入要查询成绩最低的人数：")
ReDim 姓名最低(p), 成绩最低(p) As Integer
Cells(1, 23) = "社会后" & p & "名"
For j = 1 To p
成绩最低(j) = Application.WorksheetFunction.Small([F2:F100], j)
姓名最低(j) = Application.WorksheetFunction.Index([A1:A100], _
Application.WorksheetFunction.Match(成绩最低(j), [F1:F100], 0), 1)
Cells(1 + j, 23) = 姓名最低(j)
Cells(1 + j, 24) = 成绩最低(j)
Next j
On Error Resume Next
Dim s As Integer, t As Integer
s = InputBox("请输入要查询成绩最低的人数：")
ReDim 姓名最低(s), 成绩最低(s) As Integer
Cells(1, 25) = "思品后" & s & "名"
For t = 1 To s
成绩最低(t) = Application.WorksheetFunction.Small([G2:G100], t)
姓名最低(t) = Application.WorksheetFunction.Index([A1:A100], _
Application.WorksheetFunction.Match(成绩最低(t), [G1:G100], 0), 1)
Cells(1 + t, 25) = 姓名最低(t)
Cells(1 + t, 26) = 成绩最低(t)
Next t
End Sub