(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