検証環境
- CPU: Pentium Dual Core CPU E6300 (2.80GHz)
- メモリ: 2.00GB
- OS: Windows 10(32 bit)
- Office: Excel 2016
主な機能
- ランダムな数字
4桁(指定桁数分）を左0埋めの文字列として出力する - 100回処理のベンチマークテスト結果を後に置いています。O(n)での最速処理を目指しました。
作成の背景
- パスワード管理のツールとして、共通部数種類と末尾部数字4桁の組み合わせで生成したいため
- 追加：汎用性をもたせるため、生成アルゴリズムを若干変更
今後できそうなこと
-
長い文字列への対応（現在4桁まで、4桁以上はループさせて切り出し）（完了） - →アルゴリズムを大幅改善し、処理速度が約50倍～5倍に縮小。ただし文字列長依存のO(n)に。
- →ただ、1文字あたりの増加率が多くても10%程度で、1000文字で推定約20(s)。
- 16進数対応
- 英数字対応（大文字のみ→小文字含むものへ拡張）
メインのソース
GetRandomDigitsUtil.bas
Public Function GetRandom4Digit(Optional ByVal digit As Integer = 4) As String
Dim longVal As Long
Dim passStr As String
Dim charVal As String
Dim charIdx As Long, loopCount As Integer
passStr = ""
longVal = 0
Do While Len(GetRandom4Digit) < digit
Randomize
passStr = CStr(Rnd)
Randomize
passStr = passStr & CStr(Rnd)
passStr = Replace(passStr, "0.", "")
passStr = Replace(passStr, ".", "")
passStr = Replace(passStr, "E-", "")
' 前回のこのプロシージャの前半を流用
For charIdx = 1 To Len(passStr)
' ここでもう4桁分を数値化、For文で1文字(1桁)ずつシフト
longVal = longVal + CLng(Mid$(passStr, charIdx, 4))
' 5桁になったら下1桁を結果に追記、右1桁シフトしたものを新たな値とする
If longVal >= 10000 Then
GetRandom4Digit = GetRandom4Digit & Right(CStr(longVal), 1)
longVal = CLng(Left(CStr(longVal), Len(CStr(longVal)) - 1))
End If
DoEvents
Next
Loop
GetRandom4Digit = Left(GetRandom4Digit, digit)
End Function
ベンチマークテスト
- 100回分の処理時間を計測（結果の表は25文字以降は30から10ごと）
結果
（文字列長-処理時間/100回-前回比）
| 生成文字列長 | 処理時間(s) | 前回比 |
|---|---|---|
| 1 | 0.320 | - |
| 2 | 0.227 | -29.27% |
| 3 | 0.266 | 17.24% |
| 4 | 0.242 | -8.82% |
| 5 | 0.258 | 6.45% |
| 6 | 0.313 | 21.21% |
| 7 | 0.313 | 0.00% |
| 8 | 0.313 | 0.00% |
| 9 | 0.344 | 10.00% |
| 10 | 0.375 | 9.09% |
| 11 | 0.398 | 6.25% |
| 12 | 0.414 | 3.92% |
| 13 | 0.430 | 3.77% |
| 14 | 0.445 | 3.64% |
| 15 | 0.453 | 1.75% |
| 16 | 0.477 | 5.17% |
| 17 | 0.555 | 16.39% |
| 18 | 0.531 | -4.23% |
| 19 | 0.547 | 2.94% |
| 20 | 0.563 | 2.86% |
| 21 | 0.594 | 5.56% |
| 22 | 0.609 | 2.63% |
| 23 | 0.609 | 0.00% |
| 24 | 0.656 | 7.69% |
| 25 | 0.672 | 2.38% |
| 30 | 0.758 | - |
| 40 | 0.953 | - |
| 50 | 1.125 | - |
| 60 | 1.367 | - |
| 70 | 1.563 | - |
| 80 | 1.750 | - |
| 90 | 2.008 | - |
| 100 | 2.156 | - |
テスト用プロシージャ
TestProc.bas
'テスト用プロシージャ(100回テスト)
Private Sub Test(ByVal lenLimit As Integer, ByVal rng As Range)
Dim startTime As Single, beginProc As Single, endProc As Single, timeProc As Single
Dim idx As Integer
Dim offsetLimit As Integer, sampleDigit As Long
Dim resultStr As String, tempLng As Long
Dim y0 As Integer, y1 As Single, x0 As Single, x1 As Single
Dim nextRate As Single
resultStr = ""
offsetLimit = WorksheetFunction.Min(lenLimit, 0)
startTime = Timer
beginProc = 0
sampleDigit = 100
For idx = 1 To 100
resultStr = ""
beginProc = Timer
Do
resultStr = resultStr & GetRandom4Digit(lenLimit)
Loop While Len(resultStr) < lenLimit
resultStr = Left(resultStr, lenLimit)
Debug.Print "Result: " & resultStr & "(" & Len(resultStr) & ")"
endProc = Timer
timeProc = endProc - beginProc
Next
With rng
.Offset(0, 1).NumberFormat = "0.000"
.Offset(0, 1).Value = (Timer - startTime)
If .Row = 2 Then
.Offset(0, 2).Value = "-"
Else
.Offset(0, 2).NumberFormat = "0.00%"
.Offset(0, 2).Value = (.Offset(0, 1).Value / .Offset(-1, 1).Value) - 1
End If
End With
End Sub
Public Sub TestMain()
Dim wkSht As Worksheet, rng As Range
Dim lenCount As Integer
Call FindSheet("benchmarkTest", wkSht, False, True, ThisWorkbook)
Set rng = wkSht.Cells(1, 1)
With rng
.Value = "len"
.Offset(0, 1).Value = "Time(s)"
.Offset(0, 2).Value = "rate"
End With
For lenCount = 1 To 100
Set rng = wkSht.Cells(lenCount + 1, 1)
With rng
.Value = lenCount
.Interior.Color = RGB(192, 192, 128)
.Offset(0, 1).Interior.Color = RGB(192, 192, 128)
End With
Call Test(lenCount, rng)
With rng
.Interior.ColorIndex = 0
.Offset(0, 1).Interior.ColorIndex = 0
End With
Next
wkSht.Activate
End Sub