対象者のダミーデータジェネレータ

 リハビリシステムからエクスポートされた表を操作するVBAを作る時、元データは個人情報であるので管理が大変である。できれば個人情報でない、それらしいデータが欲しいので、ダミーデータを出力してくれるVBAを組んでみた。特徴は以下の通り。

  • 年齢はランダムなものの、正規分布に従った数値が得られる。
  • 苗字、名前とも頻度の高いものは、それなりに出力される確率も高い。
  • 年齢に応じて選ばれる名前が変わる。

まずは、データ収集から。苗字については検索するとランキング形式の表がすぐ入手できた。かなりの数があったが、1000件くらいを入手。ランキングだけでなく、おおよその人数まで入っているのはありがたい。
必要なのは、累積された割合(上から順番に割合を足したもの)なので、苗字の横に計算した累積割合を入力する。「井上」は16位ですねえ。
f:id:Hanamaru:20140211153907j:plain

名前データは、なかなかいいのが見つからなかったが、男女・年代別に30位まで書かれた表が見つかったのでそれを利用。年代部分には、西暦で最後の年を入力し、ランキング部分には、上位ほど割合が高くなるよう適当に重み付けした累積割合を同様に入力した。これで準備完了。男女それぞれ別シートの一覧にしました。
f:id:Hanamaru:20140211154005j:plain

ここからはコードの作成。まずは性別だが、特に難しい部分はなし。当然、半分ずつになるように出力。

'ランダムに性別を取得する関数
Function GetGender() As String

    If Rnd() > 0.5 Then
        GetGender = "男"
    Else
        GetGender = "女"
    End If
    
End Function

次は苗字の取得。

'ランダムに苗字を取得する関数
Function GetFamilyName() As String

    Dim i As Long
    Dim myRnd As Single
    Dim mySheet As Worksheet
    
    Set mySheet = ActiveWorkbook.ActiveSheet
    Sheets("苗字").Select
    myRnd = Rnd()
    
    For i = 2 To 1001
        If Cells(i, 2).Value >= myRnd Then
            GetFamilyName = Cells(i, 1).Value
            Exit For
        End If
    Next i
    
    mySheet.Select

0~1の乱数を取得し、それを上から順番に累積割合と比較する。乱数より大きな最初の数字の行の苗字を取得する。

名前取得は結構ややこしい。

'ランダムに、性別・年齢に応じた名前を取得する関数
Function GetGivenName(myAge As Long, myGender As String) As String

    Dim mySheet As Worksheet
    Dim myBirthYear As Long
    Dim myCol As Long
    Dim myRnd As Single
    Dim i As Long
    
    Set mySheet = ActiveWorkbook.ActiveSheet
    myBirthYear = Year(Now) - myAge
    
    '性別に応じ、シートを選択
    If myGender = "男" Then
        Sheets("male").Select
    Else
        Sheets("female").Select
    End If
    
    '誕生年に合わせ、検索する列を設定
    For i = 12 To 1 Step -1
        If Cells(1, i).Value > myBirthYear Then
            myCol = i
            Exit For
        End If
    Next i

    '乱数を利用し、名前を取得
    myRnd = Rnd()
    For i = 2 To 31
        If Cells(i, 13).Value >= myRnd Then
            GetGivenName = Cells(i, myCol).Value
            Exit For
        End If
    Next i
    
    mySheet.Select
    
End Function

年齢から生まれた年を概算し、該当する年代の列数を取得。あとは苗字と同じで、乱数を発生させてその乱数より大きな最初の数字の行の名前を取得する。

そしてこれがメインプログラム

'メインプログラム
Sub main()

    Dim myGender As String
    Dim myAge As Long
    Dim personNum As Long
    Dim meanNum As Single
    Dim SDNum As Single
    Dim myFamilyName As String
    Dim myGivenName As String
    
    Randomize
    personNumber = Range("F2").Value
    Range(Cells(2, 1), Cells(Range("A2").End(xlDown).Row, 3)).Clear
    For i = 2 To personNumber + 1
        '性別を取得
        myGender = GetGender()
        Cells(i, 2).Value = myGender
        
        '設定値を読み取り、年齢を取得
        meanNum = Range("F3").Value
        SDNum = Range("F4").Value
        myAge = CInt(WorksheetFunction.NormInv(Rnd(), meanNum, SDNum))
        Cells(i, 3).Value = myAge
    
        '苗字と名前を取得し、セルに書き込む
        myFamilyName = GetFamilyName()
        myGivenName = GetGivenName(myAge, myGender)
        Cells(i, 1).Value = myFamilyName & " " & myGivenName
    
    Next i
        
End Sub

年齢はここで作成している。

 myAge = CInt(WorksheetFunction.NormInv(Rnd(), meanNum, SDNum))

WorksheetFunctionで、シート上の関数が使える。
NormInv(Rnd(), meanNum, SDNum)では、引数の一番目に乱数を入れ、2番目に平均値、3番目に標準偏差を入力すれば、これで正規分布にしたがった乱数が取得できる。

件数に応じ、作成したダミーデータを順番にワークシートに入力する。

そして作成されたダミーデータは以下の通り。
f:id:Hanamaru:20140211154126j:plain

まあまあ、自然な名前になっているので満足。コードは、シートの移動など雑な部分もありますが、ちゃんと名前出てくるのでよしとしておきます。