検証環境

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