1、在工作表“学生名单”里，命令按钮点击事件，调用生成数据过程：Private Sub CmdGenerateData_Click() Call generateDataEnd Sub 2、在myModule模块里，generateData过程，生成随机姓名、手机号，存入学生名单表：Sub generateData() Dim arr(), dic As Object, arrName(), arrNum(), rng As Range Dim lastRow As Long, lastCol As Long Dim ws As Worksheet, num As Long Set ws = ThisWorkbook.Sheets("学生名单") Set dic = CreateObject("Scripting.Dictionary") arr = ws.Range("A1").CurrentRegion num = UBound(arr) - 1 For i = 1 To num dic(arr(i + 1, 3)) = 1 dic(arr(i + 1, 5)) = 1 Next arrName = generateNames(1, num, dic) arrNum = generatePhoneNums(num, dic) With ws .Cells(2, 3).Resize(UBound(arrName)) = Application.Transpose(arrName) Set rng = .Cells(2, 5).Resize(UBound(arrNum)) With rng .NumberFormat = "@" .Value = Application.Transpose(arrNum) End With End WithEnd Sub3、在myModule模块里，自定义函数generateNames，生成姓名；自定义函数generatePhoneNums，生成随机手机号码：Function generateNames(gType As Integer, num As Long, exDic As Object) As Variant Dim arr(), arrFirstName(), arrLastName() Dim lastName As String, firstName As String, currName As String, rndName As String Dim ws As Worksheet Dim dic As Object Dim IsValidName As Boolean Dim lastRow As Long, rndRow As Long Dim i As Long Set ws = ThisWorkbook.Sheets("姓名") Set dic = CreateObject("Scripting.Dictionary") ReDim arr(1 To num) '// 读取姓氏和名字列表 With ws lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row arrLastName = .Cells(2, 1).Resize(lastRow - 1, 1).Value lastRow = .Cells(.Rows.Count, 2).End(xlUp).Row arrFirstName = .Cells(2, 2).Resize(lastRow - 1, 1).Value End With For i = 1 To num IsValidName = False Do While IsValidName = False '// 随机选择姓氏 rndRow = Int((UBound(arrLastName) - LBound(arrLastName) + 1) * Rnd + LBound(arrLastName)) lastName = arrLastName(rndRow, 1) '// 随机选择名字 rndRow = Int((UBound(arrFirstName) - LBound(arrFirstName) + 1) * Rnd + LBound(arrFirstName)) firstName = arrFirstName(rndRow, 1) currName = lastName & firstName '// 根据 gType 确定姓名长度 If gType = 3 Then '// 生成三个字的姓名 rndRow = Int((UBound(arrFirstName) - LBound(arrFirstName) + 1) * Rnd + LBound(arrFirstName)) rndName = arrFirstName(rndRow, 1) currName = currName & rndName ElseIf gType = 1 Then '// 生成2~3个字的姓名 If Rnd < 0.5 Then rndRow = Int((UBound(arrFirstName) - LBound(arrFirstName) + 1) * Rnd + LBound(arrFirstName)) rndName = arrFirstName(rndRow, 1) currName = currName & rndName End If End If '// 检查姓名是否已存在 If Not exDic.exists(currName) And Not dic.exists(currName) Then arr(i) = currName dic(currName) = 1 IsValidName = True End If Loop Next generateNames = arrEnd Function
Function generatePhoneNums(num As Long, exDic As Object) As Variant Dim arr(), arr2() Dim ws As Worksheet Dim dic As Object Dim IsValidNum As Boolean Dim currNum As String, rndNum As Long, rndRow As Long Dim i As Long Set ws = ThisWorkbook.Sheets("姓名") Set dic = CreateObject("Scripting.Dictionary") ReDim arr(1 To num) arr2 = Array(3, 5, 7, 8, 9) For i = 1 To num IsValidNum = False Do While IsValidNum = False rndRow = Int((UBound(arr2) - LBound(arr2) + 1) * Rnd + LBound(arr2)) rndNum = Int(999999999 * Rnd) currNum = "1" & arr2(rndRow) & Format(rndNum, "000000000") '// 检查号码是否存在于 exDic 和 dic 中 If Not exDic.exists(currNum) And Not dic.exists(currNum) Then arr(i) = currNum dic(currNum) = 1 IsValidNum = True End If Loop Next generatePhoneNums = arrEnd Function
|
