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

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

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