Excelで誕生日管理システム作ってみたった

はじめに

　今回私がこの誕生日管理システムを作ろうと思った理由は、ある企業のインターンシップに参加させていただいたときに、その内容がExcel VBAを使ってシステム開発という内容でした。実際に作ってみてとても楽しかったので、今回Excel VBAでのシステムを作ってみました。
　さらに、僕は誕生日を覚えるのがとてつもなく苦手なので、ちょうどExcelで作れるんじゃと思い作ってみました。

Excelフォーム

　上の画像のようにフォームの入力画面を作っています。

プログラム

Private Sub CommandButton1_Click()
    ' 登録ボタンがクリックされたときに実行されるコード

    ' シートを取得
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1") 
    
    ' 新しい名前を取得
    Dim newName As String
    newName = TextBox1.Value
    
    ' 名前が重複していないか確認
    Dim duplicateRow As Range
    Set duplicateRow = ws.Columns(1).Find(newName, LookIn:=xlValues, lookat:=xlWhole)
    
    ' 名前が重複していない場合は登録
    If duplicateRow Is Nothing Then
        Dim newBirthday As Date
        ' 新しい生年月日を入力
        If IsDate(TextBox2.Value) Then
            newBirthday = CDate(TextBox2.Value)
            ' 新しいデータをシートに書き込む
            Dim lastRow As Long
            lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1
            ws.Cells(lastRow, 1).Value = newName
            ws.Cells(lastRow, 2).Value = newBirthday
            MsgBox "データが登録されました。"
        Else
            MsgBox "例を見ろドアホ!!"
        End If
    Else
        MsgBox "同じ名前があるわドアホ!!"
    End If
    
End Sub

Private Sub CommandButton2_Click()
' 表示ボタンがクリックされたときに実行されるコード

    ' シートを取得
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1") 
    
    ' 検索する名前を取得
    Dim searchName As String
    searchName = TextBox3.Value
    
    ' 名前が一致する行を検索
    Dim foundRow As Range
    Set foundRow = ws.Columns(1).Find(searchName, LookIn:=xlValues, lookat:=xlWhole)
    
    ' 名前が見つかった場合は生年月日を表示し、そうでなければメッセージを表示
    If Not foundRow Is Nothing Then
        Dim birthday As Date
        birthday = ws.Cells(foundRow.Row, 2).Value
        TextBox4.Value = Format(birthday, "yyyy年mm月dd日")
    Else
        TextBox4.Value = "名前が見つかりませんでした。"
    End If
End Sub

Private Sub CommandButton3_Click()
    ' 修正ボタンがクリックされたときに実行されるコード

    ' シートを取得
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1") 
    
    ' 検索する名前を取得
    Dim searchName As String
    searchName = TextBox3.Value
    
    ' 名前が一致する行を検索
    Dim foundRow As Range
    Set foundRow = ws.Columns(1).Find(searchName, LookIn:=xlValues, lookat:=xlWhole)
    
    ' 名前が見つかった場合は生年月日を修正
    If Not foundRow Is Nothing Then
        Dim newBirthday As Date
        ' 新しい生年月日を入力
        If IsDate(TextBox4.Value) Then
            newBirthday = CDate(TextBox4.Value)
            ' 生年月日をシートに書き込む
            ws.Cells(foundRow.Row, 2).Value = newBirthday
            MsgBox "生年月日が修正されました。"
        Else
            MsgBox "無効な生年月日です。"
        End If
    Else
        MsgBox "名前が見つかりませんでした。"
    End If

End Sub

Private Sub CommandButton4_Click()
    ' 消去ボタンがクリックされたときに実行されるコード

    ' シートを取得
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1") 
    
    ' 検索する名前を取得
    Dim searchName As String
    searchName = TextBox3.Value
    
    ' 名前が一致する行を検索
    Dim foundRow As Range
    Set foundRow = ws.Columns(1).Find(searchName, LookIn:=xlValues, lookat:=xlWhole)
    
    ' 名前が見つかった場合は行を削除
    If Not foundRow Is Nothing Then
        ' 行を削除
        foundRow.EntireRow.Delete
        MsgBox "データが削除されました。"
    Else
        MsgBox "名前が見つかりませんでした。"
    End If

End Sub

実行結果

　↑このように名前と生年月日を入力します。

　↑登録ボタンを押すとメッセージが表示され、

↑Excelのシートのほうにデータが保存されます。

　↑名前を入力し表示ボタンを押すと、下のテキストボックスにその人の誕生日が表示されるというプログラムになっています。

さらにはプログラムを見てもらうとわかる通り、名前が重複していたらメッセージを表示したり、訂正ボタンや消去ボタンなどでデータを変えたりできるようにもなっています。

最後に

　さすがにこのようなプログラムをインターンシップに行っただけの知識では作れないので、いろいろ調べたりなどしてプログラムを書きました。実用的かと聞かれたらそこまでなのですが、プログラムを書いてシステムを作るということがとても楽しかったし、勉強にもなりました。