ビジネスに役立つ講座や交流会を開催
社長・個人事業主からサラリーマン・主婦まで、どなたでも
アベノ塾

ホーム  会場案内  お問合せ

〒545-0052
大阪市阿倍野区阿倍野筋3-12-2
あべのクオレ1F
(ナガセキャリアプラザ アベノ校)
TEL 06-6647-5571

(a)登録

名簿等のマスターデータはレコード・行を決める(特定する)一意(ユニークともいう)のキーを持っております。
通常そのキーは変更することがありません。
今回もコード番号をキーとして追加登録をします。
フォームを開いたときに最終行のデータを見つけてそのコード番号に1を加算したコード番号をラベルに表示します。
登録フォームを作ってオブジェクトをあらかじめ貼り付けておかないといけません。

Private Sub UserForm_Initialize()
    Dim i As Long
    Dim lastrow As Long
    lastrow = Worksheets("名簿").Cells(Rows.Count, 1).End(xlUp).Row
    lblNo.Caption = Worksheets("名簿").Cells(lastrow, 1) + 1
End Sub
追加登録のボタンを押したときに入力したデータを名簿シートの最終行+1にコピーします。
    Worksheets("名簿").Cells(lastrow + 1, 1) = lblNo.Caption
男・女の性別をオプションボタンで選択しているところは
VBA実践塾の部品集フォームhttp://vba.asai.net
をコピーして修正してください。2つの条件ですからif文でもselect文でも可能です。
Private Sub cmdJikkou_Click()
    Dim lastrow As Long
    lastrow = Worksheets("名簿").Cells(Rows.Count, 1).End(xlUp).Row
    Worksheets("名簿").Cells(lastrow + 1, 1) = lblNo.Caption
    Worksheets("名簿").Cells(lastrow + 1, 2) = txtName.Text
    Worksheets("名簿").Cells(lastrow + 1, 3) = txtFurigana.Text
    If optOtoko.Value = True Then
       Worksheets("名簿").Cells(lastrow + 1, 4) = "男"
     Else
       Worksheets("名簿").Cells(lastrow + 1, 4) = "女"
    End If
    Worksheets("名簿").Cells(lastrow + 1, 5) = txtSeinen.Text
    Worksheets("名簿").Cells(lastrow + 1, 7) = txtAdd.Text
    Unload Me
End Sub

(b)訂正

コード番号で検索して訂正するとします。
訂正がなければ照会プログラムになります。
追加登録もそうでしたが今回もプログラム変数を使わず、オブジェクト変数とセル変数だけでプログラムを書いていきます。
複雑な処理がなければわざわざプログラム変数を使う必要はないと思います。
オブジェクト変数に意味をもたせておけばあとから見やすいプログラムになります。
照会プログラムであればコード番号をテキストオブジェクトを使う以外すべてラベルオブジェクトで十分だと思います。
また少し難しいですが訂正フォームは登録フォームとほとんど同じですのでコピーを使ったらよいと思います。
コピーの方法は登録フォームオブジェクトからファイルをエクスポートしてメモ帳等で
中の項目とファイル名を変更してインポートで取り込めばできます。
コード番号を入力したときにそのデータを検索してきて表示(テキストボックスに代入する)するところを考えていきます。
コードのプルダウンメニューの左txtCodeと右KeyDownをクリックすると
Private Sub txtCode_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode <> 13 Then Exit Sub
コード番号を入力してエンターした時のコード13を取得します。
その下にデータを検索するプログラムを書いていきます。
Private Sub txtCode_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Dim i As Long
    Dim lastrow As Long
    lastrow = Worksheets("名簿").Cells(Rows.Count, 1).End(xlUp).Row
    If KeyCode <> 13 Then Exit Sub
    For i = 4 To lastrow
        If Worksheets("名簿").Cells(i, 1) = txtCode.Text Then
            txtName.Text = Worksheets("名簿").Cells(i, 2)
            txtFurigana.Text = Worksheets("名簿").Cells(i, 3)
            Select Case Worksheets("名簿").Cells(i, 4)
                Case "男"
                    optOtoko.Value = True
                Case "女"
                    optOnna.Value = True
            End Select
'            If Worksheets("名簿").Cells(i, 4) = "男" Then
'                optOtoko.Value = True
'            Else
'                optOnna.Value = True
'            End If
            txtSeinen.Text = Worksheets("名簿").Cells(i, 5)
            txtAdd.Text = Worksheets("名簿").Cells(i, 7)
            Exit For
        End If
    Next
End Sub
オプションボタンの取り込みはIF文とSELECT文を書いていますので勉強してください。

コード番号が見つからない時、コード番号が登録されていませんというメッセージを出す方法を考えてください。
どこにmsgbox “コード番号が登録されていません”を記入するのか
つける場所によって登録されているのに登録されていませんのメッセージが出たりします。
そのときが勉強のチャンスです。
IF ELSE ENDIF とかEXIT FOR EXIT SUBの使い方が完全にわかってきます。

次は訂正登録のプログラムです。
訂正する行を再度検索してオブジェクト変数をセル変数に代入します。
丁度呼び出しの逆をしています。


Private Sub cmdJikkou_Click()
    Dim i As Long
    Dim lastrow As Long
    lastrow = Worksheets("名簿").Cells(Rows.Count, 1).End(xlUp).Row
    For i = 4 To lastrow
        If Worksheets("名簿").Cells(i, 1) = txtCode.Text Then
           Worksheets("名簿").Cells(i, 2) = txtName.Text
           Worksheets("名簿").Cells(i, 3) = txtFurigana.Text
           If optOtoko.Value = True Then
              Worksheets("名簿").Cells(i, 4) = "男"
            Else
              Worksheets("名簿").Cells(i, 4) = "女"
           End If
           Worksheets("名簿").Cells(i, 5) = txtSeinen.Text
           Worksheets("名簿").Cells(i, 7) = txtAdd.Text
           Exit For
        End If
    Next
    Unload Me
End Sub

(c)削除

削除は照会と同じく表示のみでよいのでラベルを使います。
lblName.Caption = Worksheets("名簿").Cells(i, 2)
コード番号検索は訂正と同じものを使います。
訂正でつけなかった見つかりませんメッセージをつけています。

Private Sub txtCode_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Dim i As Long
    Dim lastrow As Long
    lastrow = Worksheets("名簿").Cells(Rows.Count, 1).End(xlUp).Row
    If KeyCode <> 13 Then Exit Sub
    For i = 4 To lastrow
        If Worksheets("名簿").Cells(i, 1) = txtCode.Text Then
            lblName.Caption = Worksheets("名簿").Cells(i, 2)
            lblFurigana.Caption = Worksheets("名簿").Cells(i, 3)
            lblSeibetu.Caption = Worksheets("名簿").Cells(i, 4)
            lblSeinen.Caption = Worksheets("名簿").Cells(i, 5)
            lblAdd.Caption = Worksheets("名簿").Cells(i, 7)
            Exit Sub
        End If
    Next
    MsgBox "見つかりません"
End Sub
行削除は行番号を使います。
Rows(行番号).delete
行番号の取得はVBA実践塾のポイントFor Nextのiを使います。

削除は間違ってしまうと困るので確認メッセージボックスを使います。
はい・いいえを選択する引数と各種記号を使ってください。
Private Sub cmdJikkou_Click()
    Dim rc As Long
    Dim i As Long
    Dim lastrow As Long
    rc = MsgBox("削除してもよろしいか", vbYesNo + vbExclamation)
    If rc = vbYes Then
        lastrow = Worksheets("名簿").Cells(Rows.Count, 1).End(xlUp).Row
        For i = 4 To lastrow
            If Worksheets("名簿").Cells(i, 1) = txtCode.Text Then
                Rows(i).Delete
                MsgBox "削除されました", vbInformation
                Exit For
            End If
        Next
   
    End If
    Unload Me
End Sub