Excel随机生成数据2

提示：扫一扫查出行
【扫一扫了解最新限行尾号】
复制提示

200万耗时大约 10秒以内，输出结果到txt文件。

Sub GetPassword() 'by kagawa
Dim i&, j&, k&, l&, m&, n&, r&, s$, s1$, s2$, t$, c1&, c2&, cnt&, tms#
tms = Timer
m = ActiveCell
If m = 0 Then m = 2 * 10 ^ 6
n = 6
s = "ABC2DEF3HJK4LM5NPQ7RST8UVW9XYZ" '原始字符特意把数字打散均匀插入字母中
s1 = "2345789" '仅数字
s2 = "ABCDEFHJKLMNPQRSTUVWXYZ" '仅字母
l = Len(s)
l1 = Len(s1)
l2 = Len(s2)
ReDim arr(1 To l) As Boolean '记录数值位置的数组以便后面检查是否含有数字
For i = 1 To l
If IsNumeric(Mid(s, i, 1)) Then arr(i) = True
Next
ReDim brr&(1 To n - 1) '密码前5位的对应序号基值方便今后调用节省计算时间
For i = 1 To n - 1
k = k + l ^ (i - 1)
brr(i) = l ^ (i - 1)
Next
ReDim crr$(1 To k * l) '定义记录前5位字符的相应序号的数组便于排除重复
t = "VN" & String(n, " ") '生成需要长度的空白字符
Open ActiveWorkbook.Path & "\Password.txt" For Output As #1 '打开Txt记录文件
Randomize '随机种子初始化以便每次宏运行时得到不同的随机序列
For i = 1 To m '生成指定个数=m的密码
Do
c1 = 0: c2 = 0: k = 0 '记录初始化 c1=含数字 c2=含字母 k=前5位序号
For j = 1 To n - 1
r = Int(Rnd * l) + 1 '取得随机字符
k = k + r * brr(j) '计算累计序号
If arr(r) Then c1 = 1 Else c2 = 1 '检查记录是否含数字或字母
Mid(t, j + 2, 1) = Mid(s, r, 1) '指定位置替换成该随机字符
Next
If c1 + c2 = 2 Then '如果数值和字符都含有了
r = Int(Rnd * l) + 1 '那就可以任意取值
Mid(t, j + 2, 1) = Mid(s, r, 1)
Else
If c1 = 0 Then '如果不含数字
r = Int(Rnd * l1) + 1 '那最后一个加入数字
Mid(t, j + 2, 1) = Mid(s1, r, 1)
Else '如果不含字母
r = Int(Rnd * l2) + 1 '最后一个加入字母
Mid(t, j + 2, 1) = Mid(s2, r, 1)
End If
End If
If crr(k) = "" Then '如果前5位序号不重复记录为空
crr(k) = t '记录本次有效结果以便今后检查重复
Print #1, t '记录到txt文件
Exit Do '退出本次计算
Else '如果该序号已有记录
If InStr(crr(k), t) = 0 Then 则进一步检查是否相同如果不同则有效
crr(k) = crr(k) & "," & t '记录中加入新的结果以便今后检查重复
Print #1, t '记录到txt文件
Exit Do '退出本次计算
Else
cnt = cnt + 1 '统计重复次数
End If
End If
Loop
Next
Close #1 '关闭txt文件
ActiveCell.Offset(, 1) = Format(Timer - tms, "0.000")
ActiveCell.Offset(, 2) = cnt
ActiveCell.Offset(1).Activate
MsgBox Format(Timer - tms, "0.000s ") & cnt & " / " & m
End Sub

生成200万不重复密码的【字典嵌套算法】，突破了字典方法在数量巨大是必然死机的障碍。
但实际速度仍然比较慢，比我的数组防止重复法要慢3-5倍。

Sub test5()
Dim d, i&, m&, s, t$, t1$, t2$, cnt&, tms#
tms = Timer
m = ActiveCell: If m = 0 Then m = 2 * 10 ^ 6
' s = Split("2 3 4 5 7 8 9 A B C D E F H J K L M N P Q R S T U V W X Y Z")
s = Split("A B C 2 D E F 3 H J K 4 L M 5 N P Q 7 R S T 8 U V W 9 X Y Z")
Open ActiveWorkbook.Path & "\Password.txt" For Output As #1
Set d = CreateObject("Scripting.Dictionary")
Randomize
Do
t1 = ""
For i = 1 To 2
t1 = t1 & s(Int(Rnd * 30))
Next
If Not d.Exists(t1) Then Set d(t1) = CreateObject("Scripting.Dictionary")
'仅取前2位字符作为key加入字典、并设置每一个New key作为嵌套的字典。
Do
t2 = ""
For i = 1 To 4
t2 = t2 & s(Int(Rnd * 30))
Next
If Not d(t1).Exists(t2) Then '后四位在字典中比对如果不重复则
t = "VN" & t1 & t2 '把密码拼接出来
If t Like "*[0-9]*" Then '确认含数字
If t Like "VN*[A-Z]*" Then '确认含字母
d(t1)(t2) = "" '该密码有效加入嵌套字典排除今后重复
Print #1, t '输出结果到txt文件
cnt = cnt + 1 '有效统计+1
Exit Do
End If
End If
End If
Loop
Loop Until cnt = m '达到目标数如 200万后退出
Close #1 '关闭txt文件
ActiveCell.Offset(, 1) = Format(Timer - tms, "0.000")
ActiveCell.Offset(1).Activate
MsgBox Format(Timer - tms, "0.000s ") & m
'下面是统计各个嵌套字典的关键词数量。
krr = d.keys
For i = 0 To d.Count - 1
Cells(i + 2, 5) = d(krr(i)).Count
Next
Set d = Nothing
End Sub

Sub test()
Dim d, i&, m&, s, t$
Randomize
m=200000 '建议不超过20万超过则字典运算速度大幅度降低。
s = Split("A B C 2 D E F 3 H J K 4 L M 5 N P Q 7 R S T 8 U V W 9 X Y Z") '按我的序列速度较快
Set d = CreateObject("Scripting.Dictionary")
t = "VN" & String(6, " ") '生成密码模板
Do
For i = 3 To 8
Mid(t, i, 1) = s(Int(Rnd * 30)) '直接替换速度更快
Next
If t Like "*[0-9]*" Then If t Like "VN*[A-Z]*" Then d(t) = "" '检查数字字母都含有时加入字典
Loop Until d.Count = m '确认字典中不重复项达到m值时退出Do循环
' [a1].Resize(m) = Application.Transpose(d.keys) '输出结果注意仅65536以下可以用Transpose
Set d = Nothing
End Sub