效果看图
【代码】
自定义函数1
'随机生成不重复指定位数文本,用法:brr=RndDigitText(位数, 个数)
'.range("A1").Resize(UBound(brr), 1) = brr
Function RndDigitText(di As Integer, number As Integer)
Dim d As Object 'New Dictionary
Dim s As String
Randomize (Timer) '初始化随机数生成器
Set d = CreateObject("Scripting.Dictionary")
Randomize (Timer)
Do Until d.Count = number
s = ""
For i = 1 To di
iRnd = Int((57 - 48 + 1) * Rnd + 48)
s = s & Chr(iRnd)
Next i
d(s) = ""
Loop
RndDigitText = Application.Transpose(d.keys)
End Function
自定义函数2
'随机生成不重复指定位数文本
'===用法:arr=RndDigitText2(位数, 个数,选项)
' 选项:1=数字2=大写字母3=小写字母4=大小写字母5=数字大小写字母
'.range("b1").Resize(UBound(brr), 1) = arr
Function RndDigitText2(nw As Integer, ng As Integer, Optional sel As Integer = 1)
Dim a As String, i&, m%, z As String, tempdic As Object
Select Case sel
Case 2
a = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Case 3
a = "abcdefghijklmnopqrstuvwxyz"
Case 4
a = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
Case 5
a = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
Case Else
a = "0123456789"
End Select
m = Len(a)
Set tempdic = CreateObject("scripting.dictionary")
Do Until tempdic.Count = ng
z = ""
For i = 1 To nw
z = z & Mid(a, WorksheetFunction.RandBetween(1, m), 1)
Next i
tempdic(z) = ""
Loop
RndDigitText2 = WorksheetFunction.Transpose(tempdic.keys)
End Function
测试运行
Sub yhd随机生成不重复指定位数文本()
Dim brr, arr, crr
With Worksheets("随机生成不重复指定位数文本")
.range("A1").Resize(100, 3).NumberFormatLocal = "@"
.range("A1").Resize(100, 3) = ""
brr = RndDigitText(18, 20)
.range("A1").Resize(UBound(brr), 1) = brr
arr = RndDigitText2(11, 30, 1)
.range("B1").Resize(UBound(arr), 1) = arr
crr = RndDigitText2(15, 30, 5)
.range("c1").Resize(UBound(arr), 1) = crr
End With
End Sub