EXCEL VBAコミュの【マクロを作ろう】パスワードを作るには？

勤め先でちょっとしたＩＤ・パスワードをいくつも作る必要が出ました。

それで、パスワードを作ってくれるサイトもあるのですが、Excel VBAで作ることも出来るだろう・・と。

とりあえずの条件
・使うのは大文字アルファベットと数字
・６ケタ
・パスワードを１０個

加えたい条件
・記号と小文字も含ませる
・記号・英字（大）・英字（小）・数字の４種類が使われていること。
・同じ文字は使用しない

さて、どんなマクロが考えられますでしょうか・・。
条件にはこだわる必要もないですし、加えたい条件もあるかも・・です。お好きにどうぞ！

コメント(42)

最初
全て
最新の40件

前

[4] mixiユーザー 03月06日 22:24

で、もっと複雑なパスワードを作るようにしてみました。

Sub PASSWORD01()
　Dim Eigi As String: Eigi = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
　Dim Eigi2 As String: Eigi2 = "abcdefghijklmnopqrstuvwxyz"
　Dim Suugi As String: Suugi = "0123456789"
　Dim Kigou As String: Kigou = "#$%&='<>_+*-/?,."
　Dim i As Integer
　Dim j As Integer
　Dim k As Integer '1-4で、英字・小英字・数字・記号
　Dim StrArray(6) As String

　Randomize
　For j = 1 To 10
　　For i = 0 To 6
　　　k = Int(4 * Rnd + 1)
　　　Select Case True
　　　Case k = 1
　　　　StrArray(i) = Mid(Eigi, Int(26 * Rnd + 1), 1)
　　　Case k = 2
　　　　StrArray(i) = Mid(Eigi2, Int(26 * Rnd + 1), 1)
　　　Case k = 3
　　　　StrArray(i) = Mid(Suugi, Int(10 * Rnd + 1), 1)
　　　Case k = 4
　　　　StrArray(i) = Mid(Kigou, Int(16 * Rnd + 1), 1)
　　　End Select
　　Next i
　　Cells(j, 1) = Replace(Join(StrArray), " ", "") 'エラーになる時がある
　Next j
　
End Sub

ところが、コードの中にも書いておいたのですが、何回か実行するとエラーになるところがあります。なぜなんだろう・・？
また、写真のように、NAME?となってしまう時があります。”="は、使わないようにするのが手っ取り早い・・かな。

あと、同じ文字を使わないようにするには、どうすれば・・と。

>3 いなぞーさん
　自動でパスワードを作って、それに変更してしまう仕組みですか！すごいですねえ・・。

[5] mixiユーザー 03月06日 23:02

>>[4]
>NAME?となってしまう時があります。”="は、使わないようにするのが手っ取り早い・・かな。
セルの書式設定を文字列にしておく(もしくは、VBAにさせる)とか
セルに書き出すときに先頭にシングルクォーテーション「'」を入れるとか

[6] mixiユーザー 03月06日 23:07

>>[4]
>あと、同じ文字を使わないようにするには、どうすれば・・と。
面倒なので、もっと簡単な方法があるかもですが
まず、Mid(Eigi, Int(26 * Rnd + 1), 1)で文字を得て
StrArray(i)に文字を入れる前にStrArray内にその文字があるか
ループで確認する、ということをDo-Loopかなにかで繰り返す
StrArray内に得た文字がなければループを抜け、StrArray(i)に入れるとか

[8] mixiユーザー 03月07日 00:17

＞あと、同じ文字を使わないようにするには、
＞どうすれば・・と。
（１）英字や数字を１文字ずつ配列に格納する。
（２）配列をランダムにシャッフルする。
（３）配列の先頭から１文字ずつ取得する。

…でどうでしょうか？

[10] mixiユーザー 03月07日 03:46

>>[4]
＞Select Case True

見慣れない記述だなぁと思って調べたら、構文上は
　Select Case <testexpression>
となっていて比較式として解釈できるなら左辺値だけでなく右辺値も記述出来たんですね。
基礎のはずなのに見落としていて、初めて知りました。

[11] mixiユーザー 03月07日 08:17

>>[009]
その方法だとチェックがNGの場合、バッファに格納しなおす必要がありますよね。パスワード長が長いほどNGの可能性が高くなります。
[008]の方法はどうでしょうか？

[13] mixiユーザー 03月07日 12:06

>>[012]
英字や数字を１文字ずつ配列に格納して、配列の並びをランダムに並び替えてるイメージです。

[14] mixiユーザー 03月08日 06:23

皆さん、ありがとう！

＞5,6　マリ男さん
・・ですね。でも、（実は）（密かに）他の言語-JAVAなんですが-でも書いてみようと思っていまして、なるべくExcelに依存しないロジックを・・と考えています。（後出しでごめんなさい。）　
また、配列に入れる前にチェックするロジックは入れてみようかな・・と。

＞7　いなぞーさん
あ～、やっぱり記号は曲者ですよね・・。いなぞーさんの前の書き込みも考えると、通信機器なんかは、入力ポートから、特別な文字列で、その機器に対するコマンドになる場合もありそうですし・・。

＞8　13　ZEBRA（みらきゅる）さん
あ、なるほど。でも、どうやってシャッフルしましょう？コードを紹介してもらえると皆さんにも参考になると思うのですが・・。書いたりテストしてみたりするのが面倒でしょうけれども。

[15] mixiユーザー 03月08日 07:28

>>[014]
配列は、『文字（String型）と乱数格納エリア（Integer型）を要素に持つユーザ定義型』を使います。
乱数格納エリアに乱数をセットし、それを昇順に並び替えればシャッフルしたことになります。

[16] mixiユーザー 03月08日 07:48

>>[014]
Javaでは、
[015]のユーザ定義型は、クラスとして実装します。
配列のソートも、Javaは標準で持っているので、マクロより簡単に実装できると思います。

[17] mixiユーザー 03月08日 23:54

>>[13]

書き込みを参考にしてコードを書いてみました。

配列の並び替えはロジックを考えないといけない（そう？）ようなので、一旦、Ｂ列に乱数、Ｃ列に文字を入れてソート。頭の６文字を持ってくるようにしてみました。

これだったら、文字は重複しないですね。

Sub PASSWORD02()
　Const Eigi As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
　Const Eigi2 As String = "abcdefghijklmnopqrstuvwxyz"
　Const Suugi As String = "0123456789"
　Const Kigou As String = "#$%&<>_+*-/?,."
　Dim Moji_all As String
　Dim i As Integer 'パスワード配列のidx
　Dim j As Integer '作ったパスワードのカウンタ
　Dim k As Integer '文字全部を一旦セルに入れる行数
　Dim StrArray(6) As String
　
　Range("A1:B10") = ""
　Moji_all = Eigi + Eigi2 + Suugi + Kigou
　
　For j = 1 To 10
　　For k = 1 To Len(Moji_all)
　　　Randomize
　　　Cells(k, 3) = Mid(Moji_all, k, 1)
　　　Cells(k, 2) = Rnd
　　Next k
　　Range(Cells(1, 2), Cells(Len(Moji_all), 3)) _
　　　.Sort Key1:=Cells(1, 2), order1:=xlAscending
　　For i = 0 To 5
　　　StrArray(i) = Cells(i + 1, 3)
　　Next i
　　Cells(j, 1) = Replace(Join(StrArray), " ", "")
　Next j
　
End Sub

=は、エラーになるので、使わない。’（シングルクォーテ）は、セルに入れるので、取り出す時にブランクになってしまうので、これも使わない。（安易だなあ・・とも。）
あと、他にも変えているところはあります。

すぐ横のＢ列・Ｃ列を使うのもどうかとは思うけど、実験みたいなものですから・・と。

こうしたらいいよ・・も、もちろん歓迎なのですが、コードを書いてくれる方も、もっと大歓迎です！

[26] mixiユーザー 03月09日 23:09

>>[025]
ソートでユーザ定義型を要素単位に入れ換えていますが、ユーザ定義型単位に入れ替えできますよ。
こんな感じで
↓
Suuji(i) = Suuji(j)

[27] mixiユーザー 03月09日 23:36

>>[025]

パスワードの生成処理は、ひとつの関数にまとめて、パスワードのタイプを引数で指定できるようにすると、使いやすいと思います。

例

関数名：
GenaratePassword
引数：
useNum As Boolean
useAlphaL As Boolean
useAlphaS As Boolean
useCode As Boolean
includeAll As Boolean
allowDuplicate As Boolean
minLength As Integer
maxLength As Integer
戻り値：
パスワード As String

[28] mixiユーザー 03月13日 17:11

>>[25]
こんな感じで作ってみました。

Option Explicit

Public Type IndexArray
Index As Integer
ShuffleBuffer As Double
End Type

Private Const PASS_STRING_NUM As String = "0123456789"
Private Const PASS_STRING_ALPHA_L As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Private Const PASS_STRING_ALPHA_S As String = "abcdefghijklmnopqrstuvwxyz"
Private Const PASS_STRING_CODE As String = "!""#$%&'()=~|@`{[+;*:}]<,>.?/_\"

Public Sub HowToUse()

Dim strErr As String
Dim pass As String

'パスワード生成
'数字のみ、10文字の場合
pass = GeneratePassword(True, False, False, False, 10, strErr)
If pass = "" Then MsgBox strErr
If pass <> "" Then MsgBox pass

'数字、英字（大）、10文字の場合
pass = GeneratePassword(True, True, False, False, 10, strErr)
If pass = "" Then MsgBox strErr
If pass <> "" Then MsgBox pass

'英数字、10文字の場合
pass = GeneratePassword(True, True, True, False, 10, strErr)
If pass = "" Then MsgBox strErr
If pass <> "" Then MsgBox pass

'英数字、記号、10文字の場合
pass = GeneratePassword(True, True, True, True, 10, strErr)
If pass = "" Then MsgBox strErr
If pass <> "" Then MsgBox pass

End Sub

長いので分割して書きます。

[29] mixiユーザー 03月13日 17:12

>>[25]

続きです。

'パスワードを生成する。
'引数：
' useNum:数字を使う
' useAlphaL:英字（大文字）を使う
' useAlphaS:英字（小文字）を使う
' useCode:記号を使う
' passLen:パスワード長
' strErr:エラー情報（パスワード生成に失敗した場合のみ）
'戻り値：
' パスワード（失敗した場合は空文字列）
Public Function GeneratePassword( _
ByVal useNum As Boolean, _
ByVal useAlphaL As Boolean, _
ByVal useAlphaS As Boolean, _
ByVal useCode As Boolean, _
ByVal passLen As Integer, _
ByRef strErr As String) As String

Dim typeNum As Integer
Dim tmpString As String

Dim IdxArr_Num() As IndexArray
Dim IdxArr_AlphaL() As IndexArray
Dim IdxArr_AlphaS() As IndexArray
Dim IdxArr_Code() As IndexArray

On Error GoTo Err_Handler

GeneratePassword = ""

typeNum = 0
tmpString = ""

If useNum = True Then
typeNum = typeNum + 1
tmpString = tmpString & PASS_STRING_NUM
IdxArr_Num = Shuffle(PASS_STRING_NUM)
End If

If useAlphaL = True Then
typeNum = typeNum + 1
tmpString = tmpString & PASS_STRING_ALPHA_L
IdxArr_AlphaL = Shuffle(PASS_STRING_ALPHA_L)
End If

If useAlphaS = True Then
typeNum = typeNum + 1
tmpString = tmpString & PASS_STRING_ALPHA_S
IdxArr_AlphaS = Shuffle(PASS_STRING_ALPHA_S)
End If

If useCode = True Then
typeNum = typeNum + 1
tmpString = tmpString & PASS_STRING_CODE
IdxArr_Code = Shuffle(PASS_STRING_CODE)
End If

'パスワード長のチェック
'例１：数字のみを指定しているのに、パスワード長を11文字している場合はエラー
' 数字のみの場合は、１文字以上、１０文字以内でないと生成できない。
If typeNum > passLen Then
strErr = _
"パスワード長が短すぎます。" & vbCrLf & _
CStr(typeNum) & "文字以上、" & _
CStr(Len(tmpString)) & "文字以内で指定してください。"

Exit Function
End If

'パスワード長のチェック
'例２：数字、英字大文字、英字小文字を指定しているのに、パスワード長を２文字しかしていない場合はエラー
' この場合は、３文字以上、６２文字以内でないと生成できない。
If Len(tmpString) < passLen Then
strErr = _
"パスワード長が長すぎます。" & vbCrLf & _
CStr(typeNum) & "文字以上、" & _
CStr(Len(tmpString)) & "文字以内で指定してください。"

Exit Function
End If

Dim i As Integer
Dim j As Integer
Dim rntPass As String

i = 0
j = 0
rntPass = ""

Do While i < passLen

If useNum = True Then
If Len(PASS_STRING_NUM) > j Then
rntPass = rntPass & Mid(PASS_STRING_NUM, IdxArr_Num(j).Index + 1, 1)
i = i + 1
End If
End If

If useAlphaL = True Then
If Len(PASS_STRING_ALPHA_L) > j Then
rntPass = rntPass & Mid(PASS_STRING_ALPHA_L, IdxArr_AlphaL(j).Index + 1, 1)
i = i + 1
End If
End If

If useAlphaS = True Then
If Len(PASS_STRING_ALPHA_S) > j Then
rntPass = rntPass & Mid(PASS_STRING_ALPHA_S, IdxArr_AlphaS(j).Index + 1, 1)
i = i + 1
End If
End If

If useCode = True Then
If Len(PASS_STRING_CODE) > j Then
rntPass = rntPass & Mid(PASS_STRING_CODE, IdxArr_Code(j).Index + 1, 1)
i = i + 1
End If
End If

j = j + 1
Loop

GeneratePassword = rntPass

Exit Function

Err_Handler:
strErr = _
"予期せぬエラーが発生。" & _
Err.Number & "、" & Err.Description
GeneratePassword = ""

End Function

長いので分割して書きます。

[30] mixiユーザー 03月13日 17:13

>>[25]

続きです。

Private Function Shuffle(ByVal passString As String) As IndexArray()

Dim i As Integer
Dim passChar() As IndexArray

ReDim passChar(Len(passString) - 1)

Randomize

For i = 0 To UBound(passChar)
passChar(i).Index = i
passChar(i).ShuffleBuffer = Rnd
Next

SortByShuffleBuffer passChar

Shuffle = passChar

End Function

Private Sub SortByShuffleBuffer(ByRef passChars() As IndexArray)

Dim i As Integer
Dim j As Integer
Dim tmp As IndexArray

For i = 0 To UBound(passChars)
For j = UBound(passChars) To i Step -1
If passChars(i).ShuffleBuffer > passChars(j).ShuffleBuffer Then
tmp = passChars(i)
passChars(i) = passChars(j)
passChars(j) = tmp
End If
Next
Next

End Sub

[31] mixiユーザー 03月13日 17:15

上記コードは、
文字のコードが重複しないようにしています。

ご指摘等あれば、お願いします。

[32] mixiユーザー 03月14日 03:23

>>[31]
パッと見た感じ、意図した通りに組めてないように思います。
　・利用する文字種が一定の並び(数字、大文字、小文字、記号)の繰り返しに固定される
　・利用する文字種のセット単位でしか生成されない(指定したパスワード長を超える場合もある)

[33] mixiユーザー 03月14日 08:17

>>[032]
ご指摘ありがとうございます。

[34] mixiユーザー 03月14日 12:49

お粗末ながらシャッフルしておくやり方で私も書いてみました。

'文字セットを示す定数群
Public Const cnstCSNone = 0 '指定なし(空集合)
Public Const cnstCSNum = 1 '数字
Public Const cnstCSAlL = 2 '英大文字
Public Const cnstCSAlS = 4 '英小文字
Public Const cnstCSSym = 8 '記号
Public Const cnstCSAllChar = cnstCSNum + cnstCSAlL + cnstCSAlS + cnstCSSym
Public Const cnstCSDefault = cnstCSAllChar

Sub GenPasswd()
Dim sPass As String
sPass = GeneratePassString(30)
Debug.Print sPass & " TNLsSNLsS"
sPass = GeneratePasswordString(30, False)
Debug.Print sPass & " FNLsSNLsS"
sPass = GeneratePasswordString(30, False, cnstCSNum, cnstCSNone)
Debug.Print sPass & " FN_______"
sPass = GeneratePasswordString(30, True, cnstCSNum + cnstCSAlL + cnstCSAlS, cnstCSNone)
Debug.Print sPass & " TNLs_____"
sPass = GeneratePasswordString(30, True, cnstCSAlL + cnstCSAlS)
Debug.Print sPass & " T_Ls__Ls_"
sPass = GeneratePasswordString(30, True, cnstCSAllChar, cnstCSNone)
Debug.Print sPass & " TNLsS____"
sPass = GeneratePasswordString(30, True)
Debug.Print sPass & " TNLsSNLsS"
sPass = GeneratePasswordString(30, True)
Debug.Print sPass & " TNLsSNLsS"
sPass = GeneratePasswordString(30, True)
Debug.Print sPass & " TNLsSNLsS"
End Sub

Function ShuffleStr(ByVal str As String) As String
Dim c As String
Dim i As Integer, j As Integer, iLength As Integer
iLength = Len(str)
For i = 1 To iLength
j = Int(Rnd() * iLength) + 1
c = Mid(str, i, 1): Mid(str, i, 1) = Mid(str, j, 1): Mid(str, j, 1) = c
Next i
ShuffleStr = str
End Function

(続く)

[35] mixiユーザー 03月14日 12:50

' nLength パスワード長
' bAllowSameChar 同一文字の利用可否
' nAvailableCharSet 利用できる文字セット(文字セットを示す定数の組み合わせで与える)
' nMustContainCharSet 必ず含める文字セット( 〃 )
Function GeneratePasswordString(nLength As Integer, _
Optional bAllowSameChar As Boolean = True, _
Optional nAvailableCharSet As Byte = cnstCSDefault, _
Optional nMustContainCharset As Byte = cnstCSDefault) As String

Dim i As Integer, j As Integer
Dim CharSetMask(3) As Integer
Dim StrDic(3) As String '辞書
Dim DicUsedCt(3) As Integer '文字セットごとの利用済文字数
Dim nCharsetCt As Integer '利用可能な文字セット数
Dim nMustCharsetCt As Integer '利用必須な文字セット数
Dim TypeTbl() As Integer '(n+1)文字目の文字セット種

Randomize
'使用不可の文字タイプはマスクする
nMustContainCharset = nMustContainCharset And nAvailableCharSet
'各文字セットごとにシャッフルされた辞書を作成＆(n+1)文字目の文字セット種を決定
ReDim TypeTbl(nLength) As Integer
nCharsetCt = 0: nMustCharsetCt = 0
CharSetMask(0) = cnstCSNum: StrDic(0) = "1234567890"
CharSetMask(1) = cnstCSAlL: StrDic(1) = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
CharSetMask(2) = cnstCSAlS: StrDic(2) = "abcdefghijklmnopqrstuvwxyz"
CharSetMask(3) = cnstCSSym: StrDic(3) = "!""#$%&'()*+,-./:;<=>?@[\]^`{|}~"
For i = 0 To 3
If nAvailableCharSet And CharSetMask(i) Then
StrDic(nCharsetCt) = ShuffleStr(StrDic(i)) '初期値を破壊するが問題無し
If nMustContainCharset And CharSetMask(i) Then '一時的に必須文字種を先頭部に強制格納
TypeTbl(nMustCharsetCt) = nCharsetCt: nMustCharsetCt = nMustCharsetCt + 1
End If
nCharsetCt = nCharsetCt + 1
End If
Next i
For i = nMustCharsetCt To nLength
TypeTbl(i) = Int(Rnd() * nCharsetCt)
Next i
'この時点でTypeTblは0～nMustCharsetCt要素目までは必ず含める文字セット種が入る
'以降はランダムなのでシャッフルして全要素ランダムに
For i = 0 To nMustCharsetCt - 1
j = Int(Rnd() * nLength)
k = TypeTbl(i): TypeTbl(i) = TypeTbl(j): TypeTbl(j) = k
Next i

'パスワード文字列生成
GeneratePasswordString = ""
Dim c As String
For i = 0 To nLength - 1
If bAllowSameChar Then
c = Mid(StrDic(TypeTbl(i)), Int(Rnd() * Len(StrDic(TypeTbl(i)))) + 1, 1)
Else
c = Mid(StrDic(TypeTbl(i)), DicUsedCt(TypeTbl(i)) + 1, 1)
DicUsedCt(TypeTbl(i)) = DicUsedCt(TypeTbl(i)) + 1
End If
GeneratePasswordString = GeneratePasswordString & c
Next i
End Function

イミディエイトペインに出力してます。

[36] mixiユーザー 03月15日 06:31

>>[6]

なかなか時間がとれなくてねえ・・。

同じ文字を使わないようにしました。
>StrArray(i)に文字を入れる前にStrArray内にその文字があるか
>ループで確認する、ということをDo-Loopかなにかで繰り返す
>StrArray内に得た文字がなければループを抜け、に入れるとか
[４]のを使い回ししたので、新たな変数を作らずに StrArray(i)に入れたのを前までに入れたのと比較。ダメだったら、そこをもう一度にしました。

Sub PASSWORD03()
Dim Eigi As String: Eigi = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Dim Eigi2 As String: Eigi2 = "abcdefghijklmnopqrstuvwxyz"
Dim Suugi As String: Suugi = "0123456789"
Dim Kigou As String: Kigou = "#$%&'<>_+*-/?,."
Dim i As Integer
Dim j As Integer
Dim k As Integer '1-4で、英字・小英字・数字・記号
Dim l As Integer 'パスワード配列のchk用idx
Dim StrArray(5) As String
Dim Onaji_chk_ok As Boolean

For j = 1 To 10
Erase StrArray
For i = 0 To 5
Onaji_chk_ok = False
Do While Onaji_chk_ok = False
Randomize
k = Int(4 * Rnd + 1)
Randomize
Select Case k
Case 1
StrArray(i) = Mid(Eigi, Int(26 * Rnd + 1), 1)
Case 2
StrArray(i) = Mid(Eigi2, Int(26 * Rnd + 1), 1)
Case 3
StrArray(i) = Mid(Suugi, Int(10 * Rnd + 1), 1)
Case 4
StrArray(i) = Mid(Kigou, Int(15 * Rnd + 1), 1)
End Select
If i = 0 Then
Onaji_chk_ok = True
Else
For l = 0 To i - 1
If StrArray(i) = StrArray(l) Then
Onaji_chk_ok = False
Exit For
Else
Onaji_chk_ok = True
End If
Next l
End If
Loop
Next i

Cells(j, 1) = Replace(Join(StrArray), " ", "")
Next j

End Sub

次は、『・記号・英字（大）・英字（小）・数字の４種類が使われていること』は、どうしますかねえ。検査してダメだったらやり直しが早いかな・・。

[37] mixiユーザー 03月16日 21:38

>>[036]
＞次は、『・記号・英字（大）・英字（小）・数字の４種類が
＞使われていること』は、どうしますかねえ。
＞検査してダメだったらやり直しが早いかな・・。

こんなアルゴリズムでどうでしょうか？

（１）記号・英字（大）・英字（小）・数字の各々の配列をシャッフルする。

（２）各配列の一番目の文字を取りだし、パスワードの１～４文字目にする。

（３）あとは、各配列の２文字目以降を取得する。（どの取得元の配列もランダムにする）

（４）できたパスワードをシャッフルする。
（先頭に記号・英字（大）・英字（小）・数字が固まっているのをバラす為）

時間があるときにでもソースを書いてみたいと思います。

[38] mixiユーザー 03月16日 21:41

>>[036]

上記アルゴリズムの実装は、文字列をシャッフルする関数を作ると、ロジックを組みやすくなるかもしれませんね。

[39] mixiユーザー 03月23日 00:17

>>[37]

今晩は。皆様も。
結局は、英字・英小文字・数字・記号を使っていなかったらやり直しをする安易な逃げ方にしてみました。
まあ、元々が全体像を考えて作ってないので、そういうことをしなければいけない時もある・・と。

あと、やたら入れ子が深くなって、なんとも・・なんでしょうねえ。

Sub PASSWORD04() '同じ文字を使っていたらやり直しをする。すべての文字種類を使ってなかったやり直し
　Dim Eigi As String: Eigi = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
　Dim Eigi2 As String: Eigi2 = "abcdefghijklmnopqrstuvwxyz"
　Dim Suugi As String: Suugi = "0123456789"
　Dim Kigou As String: Kigou = "#$%&<>_+*-/?,."
　Dim i As Integer
　Dim j As Integer
　Dim k As Integer '1-4で、英字・小英字・数字・記号
　Dim l As Integer 'パスワード配列のchk用idx
　Dim StrArray(5) As String
　Dim Onaji_chk_ok As Boolean
　Dim Eigi_ari As Boolean
　Dim Eigi2_ari As Boolean
　Dim Suugi_ari As Boolean
　Dim Kigou_ari As Boolean
　
　Range("A1:A10") = ""
　For j = 1 To 10
　　Eigi_ari = False
　　Eigi2_ari = False
　　Suugi_ari = False
　　Kigou_ari = False
　　Erase StrArray
　　Do While (Eigi_ari = False Or Eigi2_ari = False Or Suugi_ari = False Or Kigou_ari = False)
　　　Eigi_ari = False
　　　Eigi2_ari = False
　　　Suugi_ari = False
　　　Kigou_ari = False
　　　For i = 0 To 5
　　　　Onaji_chk_ok = False
　　　　Do While Onaji_chk_ok = False
　　　　　Randomize
　　　　　k = Int(4 * Rnd + 1)
　　　　　Randomize
　　　　　Select Case k
　　　　　Case 1
　　　　　　Eigi_ari = True
　　　　　　StrArray(i) = Mid(Eigi, Int(26 * Rnd + 1), 1)
　　　　　Case 2
　　　　　　Eigi2_ari = True
　　　　　　StrArray(i) = Mid(Eigi2, Int(26 * Rnd + 1), 1)
　　　　　Case 3
　　　　　　Suugi_ari = True
　　　　　　StrArray(i) = Mid(Suugi, Int(10 * Rnd + 1), 1)
　　　　　Case 4
　　　　　　Kigou_ari = True
　　　　　　StrArray(i) = Mid(Kigou, Int(14 * Rnd + 1), 1)
　　　　　End Select
　　　　　If i = 0 Then
　　　　　　Onaji_chk_ok = True
　　　　　Else
　　　　　　For l = 0 To i - 1
　　　　　　　If StrArray(i) = StrArray(l) Then
　　　　　　　　Onaji_chk_ok = False
　　　　　　　　Exit For
　　　　　　　Else
　　　　　　　　Onaji_chk_ok = True
　　　　　　　End If
　　　　　　Next l
　　　　　End If
　　　　Loop
　　　Next i
　　
　　Cells(j, 1) = Replace(Join(StrArray), " ", "")
　　Loop
　Next j
　
End Sub

[41] mixiユーザー 03月30日 20:40

>>[40]

亀レスになってしまうのですが、実行してみました。ユーザー定義関数ですので、超簡単なスクリプトから実行。

Option Explicit
Sub test()
　Dim i As Integer
　For i = 1 To 100
　　Cells(i, 1) = pass(6, False)
　Next i
　For i = 1 To 100
　　Cells(i, 2) = pass(10, False, False, False, False)
　Next i
End Sub

とっても実用的に思いました。実行しましたよ・・と言う報告のみで簡単でごめんなさい・・。

ログインすると、残り16件のコメントが見れるよ