|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Sub Lr()
Set d = CreateObject("scripting.dictionary")
Application.ScreenUpdating = False
Sheets("总表").Select
Arr = Range("a1:D" & Cells(Rows.Count, "a").End(xlUp).Row)
For j = 2 To UBound(Arr)
Set d(j) = Cells(j, 1).Resize(1, 5)
Next j
brr = Sheets("学生名单").UsedRange
x = Int(d.Count / UBound(brr))
For j = 1 To UBound(brr)
Sheets.Add after:=Sheets(Sheets.Count)
With Sheets(Sheets.Count)
.Name = brr(j, 1)
For i = 1 To x
w = WorksheetFunction.RandBetween(0, d.Count - 1)
k = d.keys()(w)
d(k).Copy .Cells(i + 1, 1)
d.Remove k
Next
End With
Next j
Application.ScreenUpdating = True
End Sub
|
评分
-
1
查看全部评分
-
|