求助：如何在sheet1中输入两次成绩后，一键生成相应的排名表？

35610101 · 发表于 2024-4-21 16:51

求助：如何在sheet1中输入两次成绩后，一键生成相应的排名表（一张两次成绩比较的进步排名表、一张后一次成绩的排名表）？

ykcbf1100 · 发表于 2024-4-21 17:10

不是应该先有个排名规则吗？

baofa2 · 发表于 2024-4-21 18:19

Sub test0()
Dim ar, i As Long, j As Long, k As Long, p As Long
ar = Sheet1.Range("A1").CurrentRegion.Resize(, 10)
ar(1, 7) = "进步名次"
ar(1, 8) = "进步排名"
ar(1, 9) = ar(1, 5) & "排名"
ar(1, 10) = ar(1, 6) & "排名"
For j = 5 To 6
QuickSort ar, 2, UBound(ar), 1, UBound(ar, 2), j
k = 0
p = j + 4
ar(2, p) = 1
For i = 2 To UBound(ar)
k = k + 1
If ar(i, j) < ar(i - 1, j) Then ar(i, p) = k Else ar(i, p) = ar(i - 1, p)
If j = 6 Then ar(i, 7) = ar(i, p - 1) - ar(i, p)
Next
Next
QuickSort ar, 2, UBound(ar), 1, UBound(ar, 2), j
k = 0
p = j + 1
ar(2, p) = 1
For i = 2 To UBound(ar)
k = k + 1
If ar(i, j) < ar(i - 1, j) Then ar(i, p) = k Else ar(i, p) = ar(i - 1, p)
Next
For j = 2 To 3
p = 8 - 2 * (j = 3)
With Worksheets(j).Range("A1").Resize(UBound(ar), UBound(ar, 2))
.CurrentRegion.Clear
.Rows(1).Font.Bold = True
.Borders.LineStyle = xlContinuous
.HorizontalAlignment = xlCenter
.Value = ar
.Sort .Item(p), xlAscending, .Item(1), , xlAscending, , , xlYes
End With
Next
Beep
End Sub
Function QuickSort(ar, u As Long, d As Long, l As Long, r As Long, pos As Long)
Dim t As Long, b As Long, j As Long, x As Long, pivot As Double, swap
t = u
b = d
pivot = ar((u + d) \ 2, pos)
While t <= b
Do
If ar(t, pos) > pivot Then t = t + 1 Else Exit Do
Loop While t < d
Do
If ar(b, pos) < pivot Then b = b - 1 Else Exit Do
Loop While b > u
If t < b Then
For x = l To r
swap = ar(t, x): ar(t, x) = ar(b, x): ar(b, x) = swap
Next
t = t + 1: b = b - 1
Else
If t = b Then t = t + 1: b = b - 1
End If
Wend
If t < d Then QuickSort ar, t, d, l, r, pos
If b > u Then QuickSort ar, u, b, l, r, pos
End Function

复制代码

baofa2 · 发表于 2024-4-21 18:22

本帖最后由 baofa2 于 2024-4-22 08:27 编辑

优化一下参考.zip (37.28 KB, 下载次数: 15)

EHGOOD · 发表于 2024-4-21 22:08

排名当然用RANK函数最方便，现成的轮子。

yynrzwh · 发表于 2024-4-21 22:58

成绩表.zip (29.64 KB, 下载次数: 17)

35610101 · 发表于 2024-4-22 09:34

感谢3、4、5、6楼的大师，都可以用！

		自动登录	找回密码
密码			免费注册

求助：如何在sheet1中输入两次成绩后，一键生成相应的排名表？

评分