ランダムパスワード生成

'パスワードに使う半角英数字と記号を指定

'各文字セットから必ず1文字が使われる
Const PASS_CHAR_1 = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Const PASS_CHAR_2 = "abcdefghijklmnopqrstuvwxyz"
Const PASS_CHAR_3 = "0123456789"
Const PASS_CHAR_4 = "!@#$%^&*_+-?"


'引数の中からランダムに1文字返す関数
Function GetRandomChar(ByVal s As String) As String
    Dim rnd_i As Long
    rnd_i = WorksheetFunction.RandBetween(1, Len(s))
    GetRandomChar = Mid(s, rnd_i, 1)
End Function


'文字をシャッフルして返す関数
Function ShuffleString(ByVal s As String) As String
    Dim i As Long
    Dim tmp As String: tmp = ""
    Dim rnd_i As Long
   
    Dim c As Collection
    Set c = New Collection
   
    For i = 1 To Len(s)
        c.Add Mid(s, i, 1)
    Next
   
    Do While c.Count > 0
        rnd_i = WorksheetFunction.RandBetween(1, c.Count)
        tmp = tmp & c(rnd_i)
        c.Remove rnd_i
    Loop
   
    Set c = Nothing
    ShuffleString = tmp
   
End Function


Function GetRandomPassword(ByVal minLen As Long, Optional ByVal maxLen As Long = 20) As String
   
    'パスワードで使用する文字を定数から取得
    Dim char1 As String: char1 = PASS_CHAR_1
    Dim char2 As String: char2 = PASS_CHAR_2
    Dim char3 As String: char3 = PASS_CHAR_3
    Dim char4 As String: char4 = PASS_CHAR_4
   
    Dim tmpPass As String: tmpPass = ""
    Dim tmpLen As Long
   
    '必須文字をランダムに1文字ずつ取得
    tmpPass = tmpPass & GetRandomChar(char1)
    tmpPass = tmpPass & GetRandomChar(char2)
    tmpPass = tmpPass & GetRandomChar(char3)
    tmpPass = tmpPass & GetRandomChar(char4)
   
    '引数不正対策
    If minLen < 4 Then minLen = 4
    If minLen > maxLen Then minLen = maxLen
   
    'パスワードの文字数を決定
    tmpLen = WorksheetFunction.RandBetween(minLen, maxLen)
   
    '指定文字数に達するまで文字を埋める
    Do While Len(tmpPass) < tmpLen
        tmpPass = tmpPass & GetRandomChar(char1 & char2 & char3 & char4)
    Loop
   
    '最後にシャッフル
    GetRandomPassword = ShuffleString(tmpPass)
   
End Function


'動作確認
Sub test()
    Dim pass As String, i As Long
    For i = 1 To 50
        pass = GetRandomPassword(i, i + 20)
        Debug.Print i & "回目:" & pass & " " & Len(pass)
    Next
End Sub