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
