2023年9月の記事でFor Each…Nextの使い方を書きましたが、実際にFor Each…Nextを使用する場合どのようにプログラムの中に組み込めばよいのか悩まれている方も多いのではないでしょうか。
そこで今回はExcelVBAで簡単な蔵書管理ができるプログラムを作成して、For Each…Nextを使用してどんなことができるのかを見ていきたいと思います。
下記の ( サンプルプログラム 1 ) の上から35行目の「本のジャンルのシートがあるかFor Eachで調べます」のコメントの下にFor Each…Nexが組み込まれています。
指定したシート(本のジャンルのシート)があるか調べるためにFor Each…Nextを使っていますのでプログラム作成の参考にしていただければ幸いです。
■蔵書管理ができるプログラムの作成手順
1. エクセルシートを開きます
2. A3から下に連番を入力します、項目名はB2に「本のジャンル」、C2に「本のタイトル」、D2に「著者」、E2に「出版社」、F2に「ISBN」を入力します。
3. 各シートに名前を付けます、「シート1」は「蔵書管理表」、「シート2」は「ビジネス」、「シート3」は「科学・テクノロジー」、「シート4」は「コンピュータ・IT」、「シート5」は「趣味」、「シート6」は「資格・検定」、「シート7」は「語学」、「シート8」は「漫画」にします。
4. VBEを起動して[挿入]メニュー → [ユーザーフォーム]でユーザーフォームを作成します。
5. ユーザーフォームにテキストボックスを5つ作成します。
6. テキストボックスの右横にラベルを貼り付けてラベルのプロパティのCaptionを「本のジャンル」「本のタイトル」「著者」「出版社」「ISBN」にします。
7. ユーザーフォームにコマンドボタンを1つ作成してコマンドボタンのプロパティのCaptionを「新規登録」にします。
8. 作成したコマンドボタンをダブルクリックしてフォームのコードウィンドウを開きPrivate Sub CommandButton1_Click()に以下のコードを貼り付けます。
( サンプルプログラム 1 )
Option Explicit
Private Sub CommandButton1_Click()
Sheets("蔵書管理表").Select
'----------------------------------------
'テキストボックスに入力があるか確認します
'----------------------------------------
If UserForm1.TextBox1.Text = "" Then
MsgBox "「本のジャンル」を入力してから新規登録ボタンを押して下さい。"
UserForm1.TextBox1.SetFocus
Exit Sub
ElseIf UserForm1.TextBox2.Text = "" Then
MsgBox "「本のタイトル」を入力してから新規登録ボタンを押して下さい。"
UserForm1.TextBox2.SetFocus
Exit Sub
End If
'------------------------------------------------------------------------
'本のタイトルが重複していないか蔵書管理表(Sheet1)のC列をCountIfで調べます
'------------------------------------------------------------------------
If WorksheetFunction.CountIf(Columns("C"), TextBox2.Value) > 0 Then
MsgBox "本のタイトル「" & TextBox2.Value & "」が重複しているので登録しません。"
Sheets("蔵書管理表").Select
Exit Sub
End If
'----------------------------------------------
'本のジャンルのシートがあるかFor Eachで調べます
'----------------------------------------------
Dim Sheet As Worksheet
Dim Flag As Boolean
For Each Sheet In Worksheets
If Sheet.Name = TextBox1.Text Then Flag = True
Next Sheet
If Flag = True Then '本のジャンルのシートがある場合の処理
MsgBox "ユーザーフォームの値を「蔵書管理表」に登録します。"
Cells(ActiveCell.Row, "B").Value = TextBox1.Text
Cells(ActiveCell.Row, "C").Value = TextBox2.Text
Cells(ActiveCell.Row, "D").Value = TextBox3.Text
Cells(ActiveCell.Row, "E").Value = TextBox4.Text
Cells(ActiveCell.Row, "F").Value = TextBox5.Text
Else '本のジャンルのシートがない場合の処理
MsgBox "本のジャンル「" & TextBox1.Value & "」のシートがありません、作成してください。"
UserForm1.TextBox1.SetFocus
Exit Sub
End If
'--------------------------------------------------
'ユーザーフォームに入力した値を各シートに転記します
'--------------------------------------------------
MsgBox "ユーザーフォームの値を「" & TextBox1.Text & "」のシートに転記します。"
Dim Target As Range
If TextBox1.Value = "ビジネス" Then
Sheets("ビジネス").Select
Set Target = Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
Target.Value = TextBox1.Value
Target.Offset(0, 1).Value = TextBox2.Value
Target.Offset(0, 2).Value = TextBox3.Value
Target.Offset(0, 3).Value = TextBox4.Value
Target.Offset(0, 4).Value = TextBox5.Value
ElseIf TextBox1.Value = "科学・テクノロジー" Then
Sheets("科学・テクノロジー").Select
Set Target = Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
Target.Value = TextBox1.Value
Target.Offset(0, 1).Value = TextBox2.Value
Target.Offset(0, 2).Value = TextBox3.Value
Target.Offset(0, 3).Value = TextBox4.Value
Target.Offset(0, 4).Value = TextBox5.Value
ElseIf TextBox1.Value = "コンピュータ・IT" Then
Sheets("コンピュータ・IT").Select
Set Target = Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
Target.Value = TextBox1.Value
Target.Offset(0, 1).Value = TextBox2.Value
Target.Offset(0, 2).Value = TextBox3.Value
Target.Offset(0, 3).Value = TextBox4.Value
Target.Offset(0, 4).Value = TextBox5.Value
ElseIf TextBox1.Value = "趣味" Then
Sheets("趣味").Select
Set Target = Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
Target.Value = TextBox1.Value
Target.Offset(0, 1).Value = TextBox2.Value
Target.Offset(0, 2).Value = TextBox3.Value
Target.Offset(0, 3).Value = TextBox4.Value
Target.Offset(0, 4).Value = TextBox5.Value
ElseIf TextBox1.Value = "資格・検定" Then
Sheets("資格・検定").Select
Set Target = Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
Target.Value = TextBox1.Value
Target.Offset(0, 1).Value = TextBox2.Value
Target.Offset(0, 2).Value = TextBox3.Value
Target.Offset(0, 3).Value = TextBox4.Value
Target.Offset(0, 4).Value = TextBox5.Value
ElseIf TextBox1.Value = "語学" Then
Sheets("語学").Select
Set Target = Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
Target.Value = TextBox1.Value
Target.Offset(0, 1).Value = TextBox2.Value
Target.Offset(0, 2).Value = TextBox3.Value
Target.Offset(0, 3).Value = TextBox4.Value
Target.Offset(0, 4).Value = TextBox5.Value
ElseIf TextBox1.Value = "漫画" Then
Sheets("漫画").Select
Set Target = Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
Target.Value = TextBox1.Value
Target.Offset(0, 1).Value = TextBox2.Value
Target.Offset(0, 2).Value = TextBox3.Value
Target.Offset(0, 3).Value = TextBox4.Value
Target.Offset(0, 4).Value = TextBox5.Value
End If
Sheets("蔵書管理表").Select
End Sub
9. [挿入] メニュー → [標準モジュール]で標準モジュールを作成します。
10. 標準モジュールに以下のコードを貼り付けます。
( サンプルプログラム 2 )
Option Explicit
Sub ユーザーフォーム1を表示()
Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Select
UserForm1.Show
UserForm1.TextBox1.SetFocus
End Sub
11. エクセルの「蔵書管理表」シートを表示して [挿入] タブの [図形] → 正方形/長方形でワークシート上に図形を挿入して図形に「フォーム表示」の文字を入力します。作成した図形を右クリックして「マクロの登録」を選び「ユーザーフォーム1を表示」を登録します。
12. フォーム表示ボタンをクリックするとユーザーフォームが表示されます。
少し長くなりましたので今回はここまで続きは次回のブログで・・・・・
コメント