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
Next
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
Next
Application.DisplayAlerts = True
End Sub
今天重新学习的内容有
1.删除工作表,
2.建立工作数
3.数组,并Redim
4.单元格的FormulaR1C1的格式,用输入了“=SUM()”与”=RANK()”公式
5.随机生成整数