|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
- Sub ba() 'by bajifeng | QQ:249346223
- nr = Array("七", "八", "九")
- gr = Array(7, 8, 9)
- ns = "年级前30名单"
- Set sh = Sheets("成绩录入")
- ar = sh.Range("a1:p" & sh.[a65336].End(3).Row)
- For ii = 0 To UBound(nr)
- chk = False
- For i = Sheets.Count To 1 Step -1
- If InStr(Sheets(i).Name, nr(ii) & ns) Then
- br = gradeAr(ar, gr(ii))
- Sheets(i).Select
- [a2].Resize(UBound(br), UBound(br, 2)) = br
- Call grade30
- chk = True
- Exit For
- End If
- If i = 1 And chk = False Then
- Sheets.Add after:=Sheets(Sheets.Count)
- Sheets(Sheets.Count).Name = nr(ii) & ns
- br = gradeAr(ar, gr(ii))
- sh.[a2].Resize(1, UBound(br, 2)).Copy [a1]
- [a2].Resize(UBound(br), UBound(br, 2)) = br
- Call grade30
- End If
- Next
- Next
- sh.Select
- MsgBox "Done!"
- End Sub
- Function gradeAr(ar, grade)
- Dim br()
- For i = 1 To UBound(ar)
- If CStr(ar(i, 1)) = CStr(grade) Then
- n = n + 1
- ReDim Preserve br(1 To UBound(ar, 2), 1 To n)
- For j = 1 To UBound(ar, 2)
- br(j, n) = ar(i, j)
- Next
- End If
- Next
- gradeAr = Application.Transpose(br)
- End Function
- Sub grade30()
- If [a65536].End(3).Row = 1 Then Exit Sub
- Dim rg As Range
- Set rg = Range([a1], ActiveSheet.UsedRange)
- rg.Sort [p1], 1, Header:=xlYes
- rg.Borders.LineStyle = 1
- rg.HorizontalAlignment = xlCenter
- [a32:p999].Clear
- End Sub
复制代码 |
评分
-
1
查看全部评分
-
|