Excel随机生成数据2

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

1. Sub GetPassword() 'by kagawa
2.     Dim i&, j&, k&, l&, m&, n&, r&, s$, s1$, s2$, t$, c1&, c2&, cnt&, tms#
3.     tms = Timer
4.     
5.     m = ActiveCell
6.     If m = 0 Then m = 2 * 10 ^ 6
7.     n = 6
8.     
9.     s = "ABC2DEF3HJK4LM5NPQ7RST8UVW9XYZ" '原始字符 特意把数字打散均匀插入字母中
10.     s1 = "2345789" '仅数字
11.     s2 = "ABCDEFHJKLMNPQRSTUVWXYZ" '仅字母
12.     l = Len(s)
13.     l1 = Len(s1)
14.     l2 = Len(s2)
15.     
16.     ReDim arr(1 To l) As Boolean '记录数值位置的数组 以便后面检查是否含有数字
17.     For i = 1 To l
18.         If IsNumeric(Mid(s, i, 1)) Then arr(i) = True
19.     Next
20.     
21.     ReDim brr&(1 To n - 1) '密码前5位的对应序号基值 方便今后调用 节省计算时间
22.     For i = 1 To n - 1
23.         k = k + l ^ (i - 1)
24.         brr(i) = l ^ (i - 1)
25.     Next
26.     ReDim crr$(1 To k * l) '定义记录前5位字符的相应序号的数组 便于排除重复
27.     
28.     t = "VN" & String(n, " ") '生成需要长度的空白字符
29.     Open ActiveWorkbook.Path & "Password.txt" For Output As #1 '打开Txt记录文件
30.     Randomize '随机种子初始化 以便每次宏运行时得到不同的随机序列
31.     For i = 1 To m '生成指定个数=m的密码
32.         Do
33.             c1 = 0: c2 = 0: k = 0 '记录初始化 c1=含数字 c2=含字母 k=前5位序号
34.             For j = 1 To n - 1
35.                 r = Int(Rnd * l) + 1 '取得随机字符
36.                 k = k + r * brr(j)     '计算累计序号
37.                 If arr(r) Then c1 = 1 Else c2 = 1 '检查记录是否含数字或字母
38.                 Mid(t, j + 2, 1) = Mid(s, r, 1) '指定位置替换成该随机字符
39.             Next
40.             
41.             If c1 + c2 = 2 Then '如果数值和字符都含有了
42.                 r = Int(Rnd * l) + 1 '那就可以任意取值
43.                 Mid(t, j + 2, 1) = Mid(s, r, 1)
44.             Else
45.                 If c1 = 0 Then '如果不含数字
46.                     r = Int(Rnd * l1) + 1 '那最后一个加入数字
47.                     Mid(t, j + 2, 1) = Mid(s1, r, 1)
48.                 Else '如果不含字母
49.                     r = Int(Rnd * l2) + 1 '最后一个加入字母
50.                     Mid(t, j + 2, 1) = Mid(s2, r, 1)
51.                 End If
52.             End If
53.             
54.             If crr(k) = "" Then '如果前5位序号不重复记录为空
55.                 crr(k) = t '记录本次有效结果 以便今后检查重复
56.                 Print #1, t '记录到txt文件
57.                 Exit Do '退出本次计算
58.             Else '如果该序号已有记录
59.                 If InStr(crr(k), t) = 0 Then 则进一步检查是否相同 如果不同则有效
60.                     crr(k) = crr(k) & "," & t '记录中加入新的结果以便今后检查重复
61.                     Print #1, t '记录到txt文件
62.                     Exit Do '退出本次计算
63.                 Else
64.                     cnt = cnt + 1 '统计重复次数
65.                 End If
66.             End If
67.         Loop
68.     Next
69.     Close #1 '关闭txt文件
70.     ActiveCell.Offset(, 1) = Format(Timer - tms, "0.000")
71.     ActiveCell.Offset(, 2) = cnt
72.     ActiveCell.Offset(1).Activate
73.     MsgBox Format(Timer - tms, "0.000s ") & cnt & " / " & m
74. End Sub

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

1. Sub test5()
2.     Dim d, i&, m&, s, t$, t1$, t2$, cnt&, tms#
3.     tms = Timer
4.     
5.     m = ActiveCell: If m = 0 Then m = 2 * 10 ^ 6
6.     
7. '    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")
8.     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")
9.     
10.     Open ActiveWorkbook.Path & "Password.txt" For Output As #1
11.     Set d = CreateObject("Scripting.Dictionary")
12.     Randomize
13.     Do
14.         t1 = ""
15.         For i = 1 To 2
16.             t1 = t1 & s(Int(Rnd * 30))
17.         Next
18.         If Not d.Exists(t1) Then Set d(t1) = CreateObject("Scripting.Dictionary")
19.         '仅取前2位字符作为key加入字典、并设置每一个New key作为嵌套的字典。
21.         Do
22.             t2 = ""
23.             For i = 1 To 4
24.                 t2 = t2 & s(Int(Rnd * 30))
25.             Next
26.             If Not d(t1).Exists(t2) Then '后四位在字典中比对 如果不重复则
27.                 t = "VN" & t1 & t2 '把密码拼接出来
28.                 If t Like "*[0-9]*" Then '确认含数字
29.                     If t Like "VN*[A-Z]*" Then '确认含字母
30.                         d(t1)(t2) = "" '该密码有效 加入嵌套字典 排除今后重复
31.                         Print #1, t '输出结果到txt文件
32.                         cnt = cnt + 1 '有效统计+1
33.                         Exit Do
34.                     End If
35.                 End If
36.             End If
37.         Loop
38.     Loop Until cnt = m '达到目标数如 200万后退出
39.     Close #1 '关闭txt文件
40.     ActiveCell.Offset(, 1) = Format(Timer - tms, "0.000")
41.        ActiveCell.Offset(1).Activate
42.     MsgBox Format(Timer - tms, "0.000s ") & m
44.     '下面是统计各个嵌套字典的关键词数量。
45.     krr = d.keys
46.     For i = 0 To d.Count - 1
47.         Cells(i + 2, 5) = d(krr(i)).Count
48.     Next
49.     Set d = Nothing
50. End Sub

1. Sub test()
2.     Dim d, i&, m&, s, t$
3.     Randomize
4.     m=200000 '建议不超过20万 超过则字典运算速度大幅度降低。
5.     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") '按我的序列速度较快
6.     Set d = CreateObject("Scripting.Dictionary")
7.     t = "VN" & String(6, " ") '生成密码模板
8.     Do
9.         For i = 3 To 8
10.             Mid(t, i, 1) = s(Int(Rnd * 30)) '直接替换速度更快
11.         Next
12.         If t Like "*[0-9]*" Then If t Like "VN*[A-Z]*" Then d(t) = "" '检查数字字母都含有时加入字典
13.     Loop Until d.Count = m '确认字典中不重复项达到m值时退出Do循环
14. '    [a1].Resize(m) = Application.Transpose(d.keys) '输出结果 注意仅65536以下可以用Transpose
15.     Set d = Nothing
16. End Sub