架空の社名

突然、面倒臭くなった。
何がって、テスト用の表を作成するのが、とても面倒くさくなったのだ。

特に面倒なのが、会社名だ。そこで、適当な社名を返す関数を作ってみた。

Function FictitiousName(Optional min_length As Long = 3, _
                        Optional max_length As Long = 5) As String

    ' 社名の文字数をランダムに決定。
    Dim NameLength As Long
        NameLength = WorksheetFunction.RandBetween(min_length, max_length)
    
    ' 社名の一文字ずつを格納する配列。
    Dim arr() As String
    ReDim arr(1 To NameLength)
    
    ' 社名の文字数分、あ～んの間で適当に平仮名をセット。
    Dim i As Long
        For i = 1 To NameLength
            arr(i) = Chr(WorksheetFunction.RandBetween(Asc("あ"), Asc("ん")))
        Next
    
    ' 社名の接頭（Prefix）または接尾（Suffix）文字をランダムに決定。
    Dim FixIndex As Long
        FixIndex = WorksheetFunction.RandBetween(0, 6)
    ' とりあえず、これだけ準備。お好みで調整可能。
    Dim FixString(6) As String
        FixString(0) = "（株）"
        FixString(1) = "社団法人"
        FixString(2) = "鉄工所"
        FixString(3) = "商事"
        FixString(4) = "運輸"
        FixString(5) = "電機"
        FixString(6) = "株式会社"
    
    ' 配列を結合して社名作成。
        Select Case FixIndex
            Case 0, 1
                FictitiousName = FixString(FixIndex) & Join(arr, vbNullString)
            Case Else
                FictitiousName = Join(arr, vbNullString) & FixString(FixIndex)
        End Select

End Function

早速、テストしてみよう。

Sub Test()
    Dim i As Long
        For i = 1 To 10
            Cells(i, 1) = FictitiousName
        Next
End Sub

これは・・・「勇者ああああ」的な感じで、ちょっと面白いかも。

次回に続きます。

参考まで。