【VBA研究】生成随机密码

作者：iamlaosong

很简单的一个功能，网上也有很多在线生成器，也有小工具可以下载，这儿用VBA做一个，结果就保存到当前工作表中，简单、快速。生成函数也可以放到其它程序中使用。函数实现的流程是：用一个变量保存所有用到的字符，然后根据级别取不同的子串，最后产生随机数，从子串中取出字符合并出随机密码。程序如下：

 

'生成密码并保存到当前工作表中
Sub GetPassword()
    len1 = Cells(2, 3)
    lev1 = Cells(2, 4)
    num1 = Cells(2, 5)
    maxrow = ActiveSheet.UsedRange.Rows.Count
    If maxrow >= 2 Then
        Range("A2:A" & maxrow).ClearContents
    End If
    
    Randomize (Timer)           '初始化随机数生成器
    For row1 = 2 To num1 + 1
        Cells(row1, 1) = GenPasswd(len1, lev1)
    Next row1
    
End Sub


'生成随机密码函数，1级=数字，2级=数字+小写字母，3级=数字+大小写字母，4级=数字+大小写字母+符号
Function GenPasswd(length, level) As String
    Dim allstr, substr, passwd As String
    
    allstr = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ!@#$%^&*()"
    '根据密码强度确定字符串长度
    Select Case level
    Case 1
        strlen = 10
    Case 2
        strlen = 36
    Case 3
        strlen = 62
    Case 4
        strlen = 72
    Case 5
        strlen = 62
    Case Else
        strlen = 72
    End Select
    '取密码字符串，其实不取也没关系，因为长度决定了取不到不想要的字符
    substr = Left(allstr, strlen)
    'Debug.Print substr
    passwd = ""
    kind_old = 0
    Do
        '字符随机位置
        pass1 = Int(Rnd * strlen + 1)
        '根据位置确定级别，保证5级以上同级别字符不重复
        If pass1 < 10 Then
            kind = 1
        ElseIf pass1 <= 36 Then
            kind = 2
        ElseIf pass1 <= 62 Then
            kind = 3
        Else
            kind = 4
        End If
        If Len(passwd) > 0 Then
            If kind <> kind_old Or level <= 4 Then
                passwd = passwd & Mid(substr, pass1, 1)
                kind_old = kind
            End If
        Else
            '首字符不用符号
            If kind < 4 Then
                passwd = passwd & Mid(substr, pass1, 1)
                kind_old = kind
            End If
        End If
    Loop While Len(passwd) < length
    GenPasswd = passwd
End Function

'生成随机数并保存到当前工作表中
Sub GetRndNumb()
    len1 = Cells(2, 3)
    lev1 = Cells(2, 4)
    num1 = Cells(2, 5)
    maxrow = ActiveSheet.UsedRange.Rows.Count
    If maxrow >= 2 Then
        Range("A2:A" & maxrow).ClearContents
    End If
    
    Randomize (Timer)           '初始化随机数生成器
    For row1 = 2 To num1 + 1
        num = Rnd
        For i = 1 To len1
            num = num * 10
        Next i
        Cells(row1, 1) = Int(num)
    Next row1
    
End Sub

程序界面：

 

下载工具：点击打开链接