ラベル(Label)にVBAコードを記述する
ボウリング成績表でも使っているユーザーフォームに配置した文字を表示するための「ラベル(Label)」にも、実はVBAコードを記述してプログラムを実行することができます。
VBAコードを実行するのはコマンドボタン(CommandButton)だけではないのです。
一般的に「表の中から特定の指定したセルの値に応じて目的のデータを検索する」場合、VLOOKUP関数がとても有名ですね。
このVLOOKUP関数はそのままエクセルVBAで使うことはできません。
その為にVBAではFindメソッドを使ってVLOOKUP関数と同じことができるようになります。
そこで「ボウリング成績表選手登録方法~LTB個人リーグ編」では、ユーザーフォームに配置した参加選手名を表示している「ラベル(Label)」に、直接VBAコードを記述して【修正登録】ボタン(コマンドボタン)を押すと検索したいデータ(名前)を選択して、表に記載されている会員番号・名前・AVE・性別を変更修正できるようにしています。
下の図の説明に関しては下記ページに記載していますので、ここでは省略します。
VBAコードが反映されるワークシートです
画像スペースの都合で、16行目まで(AA16まで)切り取って貼り付けています。実際は42行目まであります。(AA42)
Application.ScreenUpdating = False
Range(“AA1”).Value = “1”
msg = MsgBox(“選手1を修正しますか?”, Buttons:=vbYesNo + vbQuestion)
If msg = vbYes Then
Dim mycell As Range
Set mycell = Range(“AA3:AA42”).Find(What:=Range(“AA1”).Value, LookAt:=xlWhole)
If Not mycell Is Nothing Then
mycell.Select
UserForm1.TextBox1.Value = mycell.Offset(0, 1).Value
UserForm1.TextBox2.Value = mycell.Offset(0, 2).Value
UserForm1.TextBox3.Value = mycell.Offset(0, 4).Value
Else
End If
End If
Application.ScreenUpdating = True
End Sub
実際に記述しているVBAコードをそのまま書いているので、VLOOKUP関数をVBAのFindメソッド以外のコードもありますが、赤い下線の部分が表の中から探す部分です。
一応記述したVBAコードを順番に説明します。
- 「ラベル44をクリックしたら実行する」というマクロの記述を開始
- 画面のちらつき(無駄な移動)を停止する
- 検索値として選手1なので「1」をセル「AA1」に転記する
- メッセージで「選手1を修正しますか?」と表示し、「はい」「いいえ」を選択させる
- 「はい」を選択したら下記を実行する
- 選手番号が変わるので、変数として「mycell」を宣言する
- セルAA3からAA42の範囲でセルAA1と同じ値(選手番号)があるセルを検索して、見つけたセルを変数mycellに格納する
- 変数mycellの値(選手番号)が見つからない(Nothingでない場合)、要するに見つけた場合はIfステートメントの開始(もし見つけたらということになる)
- 見つけたセル「mycell」を選択する(ここ例では表の中の選手番号1はセルAA3にある)
- ユーザーフォーム1のテキストボックス1に「mycell」の同じ行で右1列目(右隣)のセルの値を転記する(会員番号)
- ユーザーフォーム1のテキストボックス2に「mycell」の同じ行で右2列目のセルの値を転記する(名前)
- ユーザーフォーム1のテキストボックス3に「mycell」の同じ行で右4列目のセルの値を転記する(AVE)
- そうでない場合(「はい」ではなく「いいえ」を選択した場合)
- Ifステートメントの終了(見つける作業をしない)
- Ifステートメントの終了(メッセージ終了)
- 画面のちらつき停止を解除する
- マクロの記録終了
これで、名前(Label)をクリックするとその選手を表の中から探して、見つけたら「会員番号」「名前」「AVE」を見つけてユーザーフォームに表示するようになります。
この作業を繰り返し選手分(40名)をラベル番号を変えながらコードを書いていけば、出来上がります。
これで修正したい表のデータが取り出せたので、次は書き換えです。
修正登録ボタンで表のデータを書き換える
それでは、この表示されたデータの書き換えを【修正登録】ボタン(コマンドボタン)でできるようにしましょう。
If UserForm1.TextBox1.Value = “” Or UserForm1.TextBox2.Value = “” Or UserForm1.TextBox3.Value = “” Then
MsgBox “修正データが自動転記されていません”
End If
msg = MsgBox(“修正実行しますか?”, Buttons:=vbYesNo + vbExclamation)
If msg = vbYes Then
ActiveCell.Offset(0, 1).Value = UserForm1.TextBox1.Value
ActiveCell.Offset(0, 2).Value = UserForm1.TextBox2.Value
ActiveCell.Offset(0, 4).Value = UserForm1.TextBox3.Value
If OptionButton1.Value = True Then
ActiveCell.Offset(0, 3).Value = “1”
ElseIf OptionButton2.Value = True Then
ActiveCell.Offset(0, 3).Value = “2”
End If
For i = 44 To 83
With UserForm1.Controls(“Label” & i)
.Caption = Cells(i – 41, 29)
End With
Next i
For j = 84 To 123
With UserForm1.Controls(“Label” & j)
.Caption = Cells(j – 81, 31)
End With
Next j
End If
End Sub
- 「コマンドボタン2をクリックしたら実行する」というマクロの記述を開始
- もしユーザーフォーム1のテキストボックス1または、ユーザーフォーム1のテキストボックス2または、ユーザーフォーム1のテキストボックス3が空欄だったら
- メッセージで「修正データが自動転記されていません」と表示する
- 空欄の時のIfステートメント終了
- 各テキストボックスが入力されていたら、メッセージで「修正実行しますか?」を「はい」「いいえ」で選択させる
- 「はい」を選択したら
- 選択されているセル(ラベルを押した時に選手番号を検索した時にすでに選択しています)の同じ行の右に1列隣のセルに(会員番号)ユーザーフォーム1のテキストボックス1に入力されている値(書き換えた会員番号)を転記する(上書きして書き換える)
- 選択されているセル(ラベルを押した時に選手番号を検索した時にすでに選択しています)の同じ行の右に2列隣のセルに(選手名)ユーザーフォーム1のテキストボックス2に入力されている値(書き換えた選手名)を転記する(上書きして書き換える)
- 選択されているセル(ラベルを押した時に選手番号を検索した時にすでに選択しています)の同じ行の右に4列隣のセルに(会員番号)ユーザーフォーム1のテキストボックス3に入力されている値(書き換えたAVE)を転記する(上書きして書き換える)
- もし(性別選択)オプションボタン1が選択されている場合
- 選択されているセル(ラベルを押した時に選手番号を検索した時にすでに選択しています)の同じ行の右に3列隣のセルに(性別)半角数字「1」を転記する(上書きして書き換える)
- そうではなく、オプションボタン2が選択されている場合
- 選択されているセル(ラベルを押した時に選手番号を検索した時にすでに選択しています)の同じ行の右に3列隣のセルに(性別)半角数字「2」を転記する(上書きして書き換える)
- オプションボタンに関するIfステートメント終了
15行目以下は、書き換えた内容が反映されているか確認できるために、再度各ラベルを再表示させる為のコードです。
これは、「複数のラベル名を一括で複数のセルの値に書き換える」ページで書いてあることと一緒になるので、ここでは省略します。
これで、簡単に言うと、データ修正ができます。
この方法を使いこなせるようになると、会員住所録などでも使えるようになるので、とても重宝しますよ。
[temp id=19]