• 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
  • 相关阅读:
    vijos 1426
    2455 繁忙的都市
    2104 删除物品
    3235 战争
    BZOJ 2962
    COGS 265 线段覆盖
    P2184 贪婪大陆
    0729模拟赛解题报告
    BZOJ 1012
    BZOJ 2763
  • 原文地址：https://www.cnblogs.com/shengs/p/4592774.html
Copyright © 2020-2023  润新知