パスワード生成アプリとかサイトとかあるんであまり需要なさそうだけど実際自分で使っていたので紹介程度に
例えば初期設定でCSVインポートでパスワードを設定できる時には重宝する(けど一生の内に何回遭遇するんだろう・・・)
Sub Sample()
Dim PW As String
PW = SetPassword(4, 12)
End Sub
Public Function SetPassword(Optional PasswordType As Long = 2, Optional PasswordLength As Long = 8) As String
'PasswordType ---1:数値、2:英小文字数字、3:英大文字英小文字数字、4:記号英小文字数字
'PasswordLength ---パスワードの文字数
Dim strPtt As String
Dim strExt As String
Dim i As Long
Dim RndMode As Long
'---パスワードタイプが規定範囲じゃなかったら強制的に数値だけにする
If PasswordType < 1 Or PasswordType > 4 Then PasswordType = 1
'---パスワードの桁数は最低でも4桁にする
If PasswordLength < 4 Then PasswordLength = 4
'---全種が必ず一度は出現するようにパターン設定する
strPtt = String(PasswordLength, "0")
For i = 1 To PasswordType
Do
strExt = Application.WorksheetFunction.RandBetween(1, PasswordLength)
If Mid(strPtt, strExt, 1) = "0" Then
strPtt = Left(strPtt, strExt - 1) & CStr(i) & Right(strPtt, PasswordLength - strExt)
Exit Do
End If
Loop
Next
'---未指定の桁を乱数で埋める
For i = 1 To PasswordLength
If Mid(strPtt, i, 1) = "0" Then
strPtt = Left(strPtt, i - 1) & CStr(Application.WorksheetFunction.RandBetween(1, PasswordType)) & Right(strPtt, PasswordLength - i)
End If
Next
'---各桁のパターンに合わせた文字コードの乱数を生成してChr関数で文字に変換する
For i = 1 To PasswordLength
Select Case CLng(Mid(strPtt, i, 1))
Case 1 '---数値
SetPassword = SetPassword & Chr(Application.WorksheetFunction.RandBetween(48, 57))
Case 2 '---小文字英字
SetPassword = SetPassword & Chr(Application.WorksheetFunction.RandBetween(97, 122))
Case 3 '---大文字英字
SetPassword = SetPassword & Chr(Application.WorksheetFunction.RandBetween(65, 90))
Case 4 '---記号 ※対象の記号→!"#$%&'()-^\@[;:],./=~|`{+*}<>?_
SetPassword = SetPassword & Chr(RandTarget(33, 34, 35, 36, 37, 38, 40, 41, 42, 43, 44, 45, 46, 47, 58, 59, 60, 61, 62, 63, 64, 91, 92, 93, 94, 95, 96, 123, 124, 125, 126))
End Select
Next
End Function
Public Function RandTarget(ParamArray arr() As Variant) As Long
Dim lngRndMin As Long, lngRndMax As Long, lngRnd As Long
Dim objDic As Scripting.Dictionary
Dim v As Variant
Set objDic = CreateObject("Scripting.Dictionary")
For Each v In arr
If IsNumeric(v) And objDic.Exists(CLng(v)) = False Then
objDic.Add CLng(v), CLng(v)
End If
Next
lngRndMin = Application.WorksheetFunction.Min(objDic.Keys)
lngRndMax = Application.WorksheetFunction.Max(objDic.Keys)
Do
lngRnd = Application.WorksheetFunction.RandBetween(lngRndMin, lngRndMax)
If objDic.Exists(lngRnd) Then
RandTarget = lngRnd
Exit Do
End If
Loop
Set objDic = Nothing
End Function
RandTargetは自作関数集から引用
簡単に言うと特定の範囲の文字コード(Chr関数のコード)を乱数で生成するやつを色々と考慮しながら作ってる感じ
数字・英小文字・英大文字・記号の組み合わせに対応させて、指定した文字は必ず1回は出現するように考慮したから結構ちゃんと作ったつもり
記号の文字コードが番号飛んでいたり半角スペースは除外ししたりする必要があったのでRandTarget使わざるを得なくなってしまった
需要はなさそうだけど色々考えて作ったんだなーってところを褒めてほしい
コメント