ExcelVBA 批量生成工作表并随机生成成绩表

'有时候我的制作教程的过程中需要一些随机的数据，如成绩表，有时也需要很多表，不想一个一个建立工作表，所以为了方便

'制作了一个随机生成工作表，并生成成绩单，姓名随机，分数随机，部分是前面的所有成绩的部分，名次是部分成绩的排名

Sub 批量添加工作表生成成绩单表()

Dim brr(), to_num, col_num, Rnd_num

Dim sht As Worksheet

Dim ss As Worksheet

Application.DisplayAlerts = False

For Each ss In Sheets

If ss.Name <> "Sheet1" Then ss.Delete

With Worksheets("Sheet1")

arr = Range("a1:b" & Range("a1").End(xlDown).Row)

to_num = UBound(arr, 1)

End With

title_arr = Array("序号", "班别", "姓名", "语文", "数学", "英语", "政治", "物理", "化学", "地理", "历史", "总分", "名次")

col_num = UBound(title_arr) 1

' MsgBox col_num

m = 1

For i = 1 To 20

Randomize

Rnd_num = Int(15 * Rnd 1)

ReDim brr(1 To Rnd_num, 1 To col_num)

For ii = 1 To UBound(brr, 1)

brr(ii, 1) = ii

brr(ii, 2) = arr(Int(to_num * Rnd 1), 2) 'arr(Application.RandBetween(2, UBound(arr, 1)), 2)

For jj = 3 To UBound(brr, 2) - 1

brr(ii, jj) = Int(100 * Rnd 1) 'Application.RandBetween(10, 100)

Next jj

Next ii

Set sht = Sheets.Add(After:=Sheets(Sheets.Count))

sht.Name = "S-" & i

With sht

Range("a1").Resize(, col_num) = title_arr

Range("a2").Resize(UBound(brr, 1), UBound(brr, 2)) = brr

Range(Cells(2, col_num - 1), Cells(UBound(brr, 1) 1, col_num - 1)).FormulaR1C1 = "=SUM(RC[-9]:RC[-1])"

Range(Cells(2, col_num), Cells(UBound(brr, 1) 1, col_num)).FormulaR1C1 = "=RANK(RC[-1],R2C[-1]:R" & UBound(brr, 1) 1 & "C[-1])"

.UsedRange.Borders.LineStyle = 1

.UsedRange.HorizontalAlignment = xlCenter

End With

Application.DisplayAlerts = True

End Sub

今天重新学习的内容有

1.删除工作表，

2.建立工作数

3.数组，并Redim

4.单元格的FormulaR1C1的格式，用输入了“=SUM()”与”=RANK()”公式

5.随机生成整数

0 人点赞