リストボックスに値やリストを登録・追加・削除フォームを作成

リスト入力フォーム作成1リストボックス

エクセルの入力をすればデータ集計や検索を行いますが、入力文字の間違えなどで集計や検索がうまくいかなかったことありませんか?

半角や全角の違いや誤字などが原因です。

これを防ぐためにリストボックスに記載されたリスト(項目)から選択させれば、間違えは起きません。

そこで値やリスト(項目)登録・追加などセルに直接記載してもいいのですが、ユーザーフォームを使って誰でも簡単に正確に入力できるように準備しましょう。

スポンサーリンク

フォームとシートの設定

リスト入力フォーム作成1
クリックで拡大します

図のように白紙状態のワークシート(sheet1)にユーザーフォームを使って値やリスト(項目)を登録・追加・削除できるようにして、ユーザーフォームにはラベル・テキストボックス・リストボックス・コマンドボタン2つを配置しています。

ユーザーフォームについてはここでは省略しますので下記をご覧くださいませ。

リストボックスを常に自動更新させる

入力フォームを作ろうとすると最初に登録ボタンからVBAコードを記載しがちですが、リストボックスがメインの入力フォームなので準備から先に行いましょう。

なぜならば、いろいろやったとしてもリストボックスのリストが常に最新版のリストになっていなければ、使い物になりません。

そこでユーザーフォームが表示される時に最新の値やリスト(項目)を取得してから、リストボックスに表示させるように設定します。

UserForm_Initialize

ユーザーフォームが表示される時に最新の値やリスト(項目)を取得させるには、UserForm_Initializeを使用します。

UserForm_Initialize

Private Sub UserForm_Initialize()
ListBox1.RowSource = Range(“A1”).CurrentRegion.Address
End Sub

VBA解説
  1. ユーザーフォームイニシャライズイベントを実行する
  2. リストボックス1のセル範囲の値はセルA1を含む入力済みセルの範囲とする
  3. マクロ記録終了

CurrentRegion.Addressで、A1セルから下方向へ空白セルを見つけたら、その1つ上のセルまでをリストボックスに表示させるセルの範囲とすることができるので、ユーザーフォームが表示されるたびに最新のセルの範囲を取得することができます。

Worksheet_Change

次にA列に変更があった場合(値やリスト(項目)が追加するされた場合)に、すでに表示中のユーザーフォームのリストボックスに即反映表示させるように設定します。

その方法はリストを記載しているシート(Sheet1)にVBAコードを記載することにより可能となります。

Worksheet_Change

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
UserForm1.ListBox1.RowSource = Target.CurrentRegion.Address
End If
End Sub

VBA解説
  1. シートに変更があった場合に処理をする
  2. もしセルA列に変更があったら
  3. ユーザーフォーム1のリストボックス1のリスト取得範囲は、変更されたセルを含む入力済みセル番地とする
  4. Ifステートメント終了
  5. マクロ記録終了

これにより、追加したい値やリスト(項目)入力してを登録ボタンを押したら、セルに記載されてさらにリストボックスにも即座に反映されます。

とりっぷぼうる
とりっぷぼうる

これで準備完了です。

それでは次に登録ボタンにVBAコードを書いてきましょう。

スポンサーリンク

登録ボタンの設定

UserForm_InitializeとWorksheet_ChangeのVBA設定が完了したことで、これからVBA設定する登録ボタンを押すことによりセルに表示・記載されて、そのままリストボックスにも表示・記載できるようにします。

ここで値やリスト(項目)を初回登録する場合(セルA列が空欄の状態)と、2つ目の値以降の2種類の登録方法がある事を忘れずに設定する必要があります。

リスト登録ボタンの設定

Private Sub CommandButton1_Click()
If Range(“A1”).Value = “” Then
Range(“A1”).Value = TextBox1.Value
TextBox1.Value = “”
Else
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = TextBox1.Value
TextBox1.Value = “”
End If
End Sub

VBA解説
  1. コマンドボタン1がクリックされたら
  2. もしセルA1が空欄だったら(初回項目登録の時)
  3. セルA1にテキストボックス1の入力文字を追加する
  4. テキストボックスを空欄にする
  5. そうでなかったら(2つ目以降)
  6. 最初の列(A列)の入力済み最終行(空欄セルの1つ上のセル)の1つ下のセルにテキストボックス1の入力文字を追加する
  7. テキストボックスを空欄にする
  8. Ifステートメント終了
  9. マクロ記録終了

これでリストがリアルタイムで追加できるようになりました。

そして入力済みになったらテキストボックスを空欄にして、二重登録を防ぐのと、次のリストを入力する時に空欄にする手間を無くす為に追加しておいた方が便利ですよ。

ちなみにリストボックスはリスト1つではなく2つ以上の複数列表示させる事も可能なのですが、初期設定では使えないので設定変更して複数列対応のリストボックスにすることができます。

スポンサーリンク

削除ボタンの設定

値やリスト(項目)の登録や追加があるならば当然削除も必要で、これが無ければ削除の時だけワークシートを直接触る事になるので、ユーザーフォームでの入力・削除が完結しません。

ただし、ここでは値やリスト(項目)が追加されると自動的にセルの範囲(RowSource)が書き換えられるようにしているので、RemoveItemメソッドは使えません

そこで、リストボックスで値やリスト(項目)を選択状態にしたら、削除するように設定します。

さらに削除されたことによりセルが空欄になると、リストボックスに空欄以下のリストが表示されなくなってしまうので上方向に空欄を詰めるようにします。

リスト削除ボタン

Private Sub CommandButton2_Click()
With ListBox1
For i = 0 To .ListCount – 1
If .Selected(i) = True Then
Cells(i + 1, 1).Value = “”
End If
Next i
End With
F = WorksheetFunction.CountA(Range(“A:A”))
For j = 1 To F
If Cells(j, 1).Value = “” Then
Cells(j, 1).End(xlDown).Cut
Cells(j, 1).Select
ActiveSheet.Paste
End If
Next j
Unload Me
UserForm1.Show
End Sub

VBA解説
  1. コマンドボタン2がクリックされたら
  2. リストボックス1に関する下記処理をする(Withステートメント実行)
  3. Forステートメント実行し、変数「i」を宣言し「i」は0~リストボックスの総行数-1まで処理を繰り返す
  4. もしリスト「i」行目が選択状態だったら
  5. セルi+1,1を空欄にする(リスト選択状態に+1でリストと選択状態が同じになる)
  6. Ifステートメント終了
  7. Withステートメント終了
  8. 変数「F」を宣言し、A列の入力済みセルの数を数えて「F」に格納する
  9. 変数「j」を宣言し、1から変数「F」まで繰り返す
  10. もしA列の「j」行目が空欄だったら
  11. 空欄だったセルの1行下のセルの値を切り取る
  12. セルA列の「j」行目(空欄のセル)を選択する
  13. 切り取った値を貼り付ける
  14. Ifステートメント終了
  15. 変数「j」を繰り返す
  16. ユーザーフォームを閉じる
  17. ユーザーフォーム1を開く
  18. マクロ記録終了

2行目から7行目までが1つのブロックになっていて、リストボックスからリストを選択状態にしてし削除ボタンを押せばA列のセルに記載された値やリスト(項目)が空欄になります。

8行目は9行目に使う入力済みセルの数を数えるCountA関数を使います。

9行目から15行目で空欄セルを見つけたら上方向に詰める為に切り取って貼り付けることにより可能になります。

最後にフォームを閉じて再度開く事により、最新のリストに更新されるという事です。

とりっぷぼうる
とりっぷぼうる

これでリストボックスに値やリスト(項目)を登録・削除できるオリジナルフォームが出来上がりました。

リストボックス関連

スポンサーリンク


リストボックス
スポンサーリンク
参考になりましたらシェア宜しくお願い致します

山頂テラスデッキからの三段紅葉(2019年11月)

フリーパスって助成金つぎ込んでいいの?

コロナ禍のGo To トラベル以外にも助成金だらけでうらやましいね。

安くなったフリーパスで遊びに行きたいけど、給与も減って余裕ないよね。

Excel VBA