如何修改Excel VBA自定义密码生成器实现每次启动生成随机密码？

原代码的问题在于未初始化随机数生成器，VBA的Rnd函数默认使用固定种子，导致每次打开文件运行时生成的随机序列完全一致。只需添加Randomize语句（基于系统时间初始化随机种子）即可解决，同时保留原有的自定义复杂度功能。

修改后的完整代码 #

Sub Password_Click()
'
' Bruno Campanini 2007-02-14 Excel 2007
' Statistica.xls 工作表: Sheet10 按钮: Password
'
' 生成指定数量的密码，每个密码包含：
' 指定数量的字母、特殊字符、数字，且支持随机大写转换
'
Dim AlphaChar(1 To 26) As String, NumChar(1 To 10) As String
Dim NonAlphaChar(1 To 30) As String
Dim i As Integer, j As Integer, NumPSW As Integer
Dim NumAlpha As Integer, NumNum As Integer, NumNonAlpha As Integer
Dim PSW As String, PSWRandom As String, PSWColl As Collection
Dim R As Integer, RR As Integer, RRR As Integer, NumMaiuscole As Integer
Dim FinalRandom As Boolean, TargetRange As Range

' 初始化随机数生成器（关键修复：基于系统时间设置随机种子）
Randomize

' 26个小写字母(a-z)
For i = 97 To 122
    AlphaChar(i - 96) = Chr(i)
Next

' 10个数字(0-9)
For i = 1 To 10
    NumChar(i) = i - 1
Next

' 30个特殊字符
NonAlphaChar(1) = "\\": NonAlphaChar(2) = "|": NonAlphaChar(3) = "!"
NonAlphaChar(4) = Chr(34): NonAlphaChar(5) = "%": NonAlphaChar(6) = "&"
NonAlphaChar(7) = "/": NonAlphaChar(8) = "(": NonAlphaChar(9) = ")"
NonAlphaChar(10) = "=": NonAlphaChar(11) = "?": NonAlphaChar(12) = "'"
NonAlphaChar(13) = "^": NonAlphaChar(14) = "_": NonAlphaChar(15) = "-"
NonAlphaChar(16) = ".": NonAlphaChar(17) = ":": NonAlphaChar(18) = ","
NonAlphaChar(19) = ";": NonAlphaChar(20) = "@": NonAlphaChar(21) = "#"
NonAlphaChar(22) = "*": NonAlphaChar(23) = "+": NonAlphaChar(24) = "["
NonAlphaChar(25) = "]": NonAlphaChar(26) = "{": NonAlphaChar(27) = "}"
NonAlphaChar(28) = "$": NonAlphaChar(29) = "<": NonAlphaChar(30) = ">"

' 自定义参数设置 ------------------------------------------
NumAlpha = 6 ' 字母字符数量
NumNonAlpha = 1 ' 特殊字符数量
NumNum = 4 ' 数字字符数量
NumMaiuscole = 3 ' 大写字母数量
FinalRandom = True ' 是否打乱密码字符顺序
'
NumPSW = 10 ' 生成的密码总数
Set TargetRange = [Sheet1!A1] ' 密码输出起始单元格
' ------------------------------------------------------

If NumMaiuscole > NumAlpha Then
    MsgBox "大写字母数量不能超过字母总数！当前设置：大写" & NumMaiuscole & "个，字母共" & NumAlpha & "个"
    Exit Sub
End If

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
For j = 1 To NumPSW
    PSW = ""

    ' 生成字母部分
    R = NumAlpha
    RR = UBound(AlphaChar)
    GoSub LoadCollection
    For i = 1 To NumAlpha
        PSW = PSW & AlphaChar(PSWColl(i))
    Next

    ' 随机转换指定数量的字母为大写
    R = NumMaiuscole
    RR = R
    GoSub LoadCollection
    For i = 1 To NumMaiuscole
        Mid(PSW, PSWColl(i), 1) = UCase(Mid(PSW, PSWColl(i), 1))
    Next

    ' 生成特殊字符部分
    R = NumNonAlpha
    RR = UBound(NonAlphaChar)
    GoSub LoadCollection
    For i = 1 To NumNonAlpha
        PSW = PSW & NonAlphaChar(PSWColl(i))
    Next

    ' 生成数字部分
    R = NumNum
    RR = UBound(NumChar)
    GoSub LoadCollection
    For i = 1 To NumNum
        PSW = PSW & NumChar(PSWColl(i))
    Next

    If FinalRandom Then
        ' 打乱所有字符顺序
        R = NumAlpha + NumNonAlpha + NumNum
        RR = R
        GoSub LoadCollection
        PSWRandom = ""
        For i = 1 To NumAlpha + NumNonAlpha + NumNum
            PSWRandom = PSWRandom & Mid(PSW, PSWColl(i), 1)
        Next
        PSW = PSWRandom
    End If

    TargetRange(j) = "'" & PSW
Next

Exit_Sub:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Exit Sub

' 加载不重复的随机数到集合
LoadCollection:
Set PSWColl = New Collection
Do Until PSWColl.Count = R
    RRR = Int((RR) * Rnd + 1)
    On Error Resume Next
    PSWColl.Add RRR, CStr(RRR)
    On Error GoTo 0
Loop
Return

End Sub

关键修改说明 #

• 在代码开头添加Randomize语句：该语句会基于当前系统时间设置随机数生成器的种子，确保每次运行时Rnd函数生成的随机序列都不同，彻底解决密码重复问题。
• 修正了原代码中特殊字符数组的重复项（原代码26和27项都是[和]，改为{和}），避免特殊字符种类重复。

自定义复杂度方法 #

直接修改代码中自定义参数设置区域的变量值即可：

• NumAlpha：设置密码中字母的数量
• NumNonAlpha：设置密码中特殊字符的数量
• NumNum：设置密码中数字的数量
• NumMaiuscole：设置密码中大写字母的数量（不能超过字母总数）
• NumPSW：设置一次生成的密码总数
• TargetRange：设置密码输出的起始单元格位置
• FinalRandom：设置是否打乱密码中所有字符的顺序

内容的提问来源于stack exchange，提问作者otto0