データベースのテスト用ユーザーレコードを自動作成するExcel VBAを書きました。(9999レコードを作成)　時間があれば、誕生日をランダムに取得できるように改良したかった。
■ レコードの最初

■ レコードの終了
'ループカウンタ
'Dim ColCnt As Long  'ループカウンタ（列）
Dim LowCnt As Long  'ループカウンタ（行）
Dim LowMax As Long  '行の上限（ユーザー数）

'社員名前
Dim SecNameKj As String
Dim SecNameFg As String
Dim SecNameEn As String

Sub TestUserCreate()
    '-------------------------------------------------------------
    '宣言部
    '-------------------------------------------------------------

    'ループカウンタ
    LowMax = 9999

    '社員コード桁数
    Dim UsrIdMax As Integer     'ID番号の上限
    Dim UsrIDCnt As Integer     'ID番号に"0"を割り当て
    Dim UsrIdStr As String

    '社員苗字
    Dim FstNameKj As String
    Dim FstNameFg As String
    Dim FstNameEn As String

    FstNameKj = "山田"
    FstNameFg = "やまだ"
    FstNameEn = "Yamada"

    '-------------------------------------------------------------
    'Excel書き出し処理
    '-------------------------------------------------------------

    For LowCnt = 1 To LowMax

        '社員コード（連番4桁テキスト）
        For IDCnt = Len(CStr(LowCnt)) To Len(CStr(LowMax))
            UsrIdStr = UsrIdStr & "0"
        Next
        Cells(LowCnt, 1).NumberFormatLocal = "@"
        Cells(LowCnt, 1).Value = UsrIdStr & CStr(LowCnt)
        UsrIdStr = ""

        '名前登録
        SecNameKj = ""
        SecNameFg = ""
        SecNameEn = ""

        Select Case Len(CStr(LowCnt))
            Case 1
                Call NameChange(1)
                Cells(LowCnt, 4).Value = "1980/01/01"
                Cells(LowCnt, 5).Value = "2000/01/01"
                Cells(LowCnt, 7).Value = "茨城県"
            Case 2
                Call NameChange(2)
                Cells(LowCnt, 4).Value = "1990/01/01"
                Cells(LowCnt, 5).Value = "2010/01/01"
                Cells(LowCnt, 7).Value = "千葉県"
            Case 3
                Call NameChange(3)
                Cells(LowCnt, 4).Value = "2000/01/01"
                Cells(LowCnt, 5).Value = "2020/01/01"
                Cells(LowCnt, 7).Value = "埼玉県"
            Case 4
                Call NameChange(4)
                Cells(LowCnt, 4).Value = "2000/10/01"
                Cells(LowCnt, 5).Value = "2020/10/01"
                Cells(LowCnt, 7).Value = "東京都"
        End Select

        Cells(LowCnt, 2).Value = FstNameKj + "　" + SecNameKj
        Cells(LowCnt, 3).Value = FstNameFg + "　" + SecNameFg
        Cells(LowCnt, 6).Value = FstNameEn + SecNameEn + "@jp.com"

    Next

End Sub

    '-------------------------------------------------------------
    '名前の桁数部分
    '-------------------------------------------------------------




Function NameChange(LenFlg As Integer)
    If LenFlg >= 4 Then
        Call NumChange(CInt(Left(Right(CStr(LowCnt), 4), 1)))
        SecNameKj = SecNameKj + "千"
        SecNameFg = SecNameFg + "せん"
        SecNameEn = SecNameEn + "sen"
    End If

    If LenFlg >= 3 Then
        Call NumChange(CInt(Left(Right(CStr(LowCnt), 3), 1)))
        If Left(Right(CStr(LowCnt), 3), 1) <> "0" Then
            SecNameKj = SecNameKj + "百"
            SecNameFg = SecNameFg + "ひゃく"
            SecNameEn = SecNameEn + "hyaku"
        End If
    End If

    If LenFlg >= 2 Then
        Call NumChange(CInt(Left(Right(CStr(LowCnt), 2), 1)))
        If Left(Right(CStr(LowCnt), 2), 1) <> "0" Then
            SecNameKj = SecNameKj + "十"
            SecNameFg = SecNameFg + "じゅう"
            SecNameEn = SecNameEn + "jyu"
        End If
    End If

    If LenFlg >= 1 Then
        Call NumChange(CInt(Right(CStr(LowCnt), 1)))
        If Right(CStr(LowCnt), 1) = "1" Then
            SecNameKj = SecNameKj + "一"
            SecNameFg = SecNameFg + "いち"
            SecNameEn = SecNameEn + "ichi"
        End If
        SecNameKj = SecNameKj + "郎"
        SecNameFg = SecNameFg + "ろう"
        SecNameEn = SecNameEn + "roh"
    End If

End Function

    '-------------------------------------------------------------
    '名前の連番部分
    '-------------------------------------------------------------

Function NumChange(NumFlg As Integer)
    Select Case NumFlg
        Case 2
            SecNameKj = SecNameKj + "二"
            SecNameFg = SecNameFg + "に"
            SecNameEn = SecNameEn + "ni"
        Case 3
            SecNameKj = SecNameKj + "三"
            SecNameFg = SecNameFg + "さん"
            SecNameEn = SecNameEn + "san"
        Case 4
            SecNameKj = SecNameKj + "四"
            SecNameFg = SecNameFg + "よん"
            SecNameEn = SecNameEn + "yon"
        Case 5
            SecNameKj = SecNameKj + "五"
            SecNameFg = SecNameFg + "ご"
            SecNameEn = SecNameEn + "go"
        Case 6
            SecNameKj = SecNameKj + "六"
            SecNameFg = SecNameFg + "ろく"
            SecNameEn = SecNameEn + "roku"
        Case 7
            SecNameKj = SecNameKj + "七"
            SecNameFg = SecNameFg + "なな"
            SecNameEn = SecNameEn + "nana"
        Case 8
            SecNameKj = SecNameKj + "八"
            SecNameFg = SecNameFg + "はち"
            SecNameEn = SecNameEn + "hachi"
        Case 9
            SecNameKj = SecNameKj + "九"
            SecNameFg = SecNameFg + "きゅう"
            SecNameEn = SecNameEn + "kyu"
    End Select

End Function
（02/03 バグ修正）