Excel VBAのユーザーフォームでテーブルの値を更新する方法

Subプロシージャの作成

VBAの中身を作成する。作成するプログラムは４つ。

• 入力フォームの表示ボタンをクリックたときに実行されるプログラム
• 商品ID、価格(円)の入力時に実行されるプログラム
• 入力フォーム内の閉じるボタンをクリックしたときに実行されるプログラム
• 入力フォーム内の新規登録ボタンをクリックしたときに実行されるプログラム
• 入力フォーム内の検索ボタンをクリックしたときに実行されるプログラム
• 入力フォーム内の訂正ボタンをクリックしたときに実行されるプログラム

入力フォームの表示ボタンをクリックたときに実行されるプログラム

ボタンはテーブルにデータを追加する方法と同じボタンを使用しているので、こちらを参照。

商品ID、価格(円)の入力時に実行されるプログラム

「VBAProject」→「フォーム」→「UserFrom1」を右クリックし「コードの表示」を選択する

下のコードをコピー＆ペーストする。

'数字以外入力不可の設定(価格)
Private Sub TextBox_価格_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    If Not Chr(KeyAscii) Like "[0-9]" Then
        KeyAscii = 0
    End If
End Sub

'数字以外入力不可の設定(商品ID)
Private Sub TextBox_商品ID_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    If Not Chr(KeyAscii) Like "[0-9]" Then
        KeyAscii = 0
    End If
End Sub

このコードはに半角の数字以外のキーが押されたら何も入力されないというプログラムである。

価格と商品IDは数字のみで構成されるため、このような仕様としている。

入力フォーム内の閉じるボタンをクリックしたときに実行されるプログラム

前項と同じUserForm１の「コードの表示」させたところにプログラムを書く。

下記をコピー＆ペーストする。すでに「Sub Button_閉じる_Click()」があれば、上書きする。

'ユーザーフォームを閉じる
Private Sub Button_閉じる_Click()

    Unload UserForm1

End Sub

入力フォーム内の新規登録ボタンをクリックしたときに実行されるプログラム

UserForm１の「コードの表示」させたところにプログラムを書く。

下記をコピー＆ペーストする。すでに「Sub Button_新規登録_Click()」があれば、上書きする。

'新規登録ボタンがクリックされた時の処理
Private Sub Button_新規登録_Click()

    '変数の宣言
    Dim RowNunber As Long   '登録しようとした製品がある行数を登録する
    Dim TableName As String     'テーブル名
    
    '変数の初期化
    RowNunber = 0
    TableName = "テーブル1"
    
     '入力した商品名がテーブルにあるかチェックする
    For i = 1 To ActiveSheet.ListObjects(TableName).Range.Rows.Count
        'データがある場合
        If ActiveSheet.ListObjects(TableName).Range(i, 2) = TextBox_商品名.Value Then
            Rownumber = i   '商品名が見つかった時はテーブルの行数を保存
            Exit For 'ループを終了
        End If
    Next



    If TextBox_商品名.Value = "" Or TextBox_価格.Value = "" Then   '必須項目が入力されていない時の処置
    
        Label_エラーメッセージ.Caption = "商品名 and/or 商品価格 を入力してください。"
        
        
    ElseIf Rownumber <> 0 Then  '既に商品が登録されている場合の処置
    
        Label_エラーメッセージ.Caption = TextBox_商品名.Value & "は登録済なので登録できません。"
    
    
    Else    '必須項目が入力されているときの処置
        'シートの保護を解除
        ActiveSheet.Unprotect
        
        
        With ActiveSheet.ListObjects(TableName)
        
            '行を追加
            .ListRows.Add
    
            '最終行に値を入力
            .Range(.Range.Rows.Count, 1) = .Range(.Range.Rows.Count - 1, 1) + 1
            .Range(.Range.Rows.Count, 2) = TextBox_商品名.Value
            .Range(.Range.Rows.Count, 3) = TextBox_価格.Value
        End With
        
        'シートの保護
        ActiveSheet.Protect
    
    End If

End Sub

まずは、入力された商品名がすでに登録されていないかを確認している。
その後、入力された内容によって、処理を３パターンに分けている。
１パターン目は、商品名または価格がだったらLabel‗エラーメッセージにエラーメッセージを表示させる。
２パターン目は、商品が既に登録されていたらLabel‗エラーメッセージにエラーメッセージを表示させる。
３パターン目は、テーブルの最終行にユーザーフォームで入力した値を追加ている。
シートの保護された状態ではテーブルへの書き込みができないので保護を解除している。
その後、テーブルに行を追加し、追加した行に商品名と価格を追加している。
最後は再びシートに保護の処置をしている。

入力フォーム内の検索ボタンをクリックしたときに実行されるプログラム

UserForm１の「コードの表示」させたところにプログラムを書く。

下記をコピー＆ペーストする。すでに「Sub Button_検索_Click()」があれば、上書きする。

'製品IDから情報を取得
Private Sub Button_検索_Click()
    '変数の宣言
    Dim TableName As String     'テーブル名
    
    '変数の初期化
    TableName = "テーブル1"

    For i = 1 To ActiveSheet.ListObjects(TableName).Range.Rows.Count
        'データがある場合
        If CStr(ActiveSheet.ListObjects(TableName).Range(i, 1).Value) = TextBox_商品ID.Value Then
            TextBox_商品名.Text = ActiveSheet.ListObjects(TableName).Range(i, 2).Value
            TextBox_価格.Text = ActiveSheet.ListObjects(TableName).Range(i, 3).Value
            
            Exit For 'ループを終了
        End If
    Next
    

End Sub

Forで入力した商品IDが存在するか検索し、存在すれば、その商品IDの商品名と価格をユーザーフォームに表示させる。

入力フォーム内の訂正ボタンをクリックしたときに実行されるプログラム

UserForm１の「コードの表示」させたところにプログラムを書く。

下記をコピー＆ペーストする。すでに「Sub Button_訂正_Click()」があれば、上書きする。

'テーブルの情報の訂正
Private Sub Button_訂正_Click()
    '変数の宣言
    Dim TableName As String     'テーブル名
    
    '変数の初期化
    Dim RowNunber As Long   '登録しようとした製品がある行数を登録する
    TableName = "テーブル1"
    
     '変数の初期化
    RowNunber = 0
    TableName = "テーブル1"
    
     '入力した商品名がテーブルにあるかチェックする
    For i = 1 To ActiveSheet.ListObjects(TableName).Range.Rows.Count
        'データがある場合
        If ActiveSheet.ListObjects(TableName).Range(i, 2) = TextBox_商品名.Value Then
            Rownumber = i   '商品名が見つかった時はテーブルの行数を保存
            Exit For 'ループを終了
        End If
    Next

    
    If TextBox_商品名.Value = "" Or TextBox_価格.Value = "" Then        '必須項目が入力されていない時の処置
    
        Label_エラーメッセージ.Caption = "商品名 and/or 商品価格 を入力してください。"
    
    ElseIf TextBox_商品ID.Value = "" Or CInt(TextBox_商品ID.Value) > ActiveSheet.ListObjects(TableName).Range.Rows.Count Then '商品IDが空白もしくは表の行数より大きい場合
    
        Label_エラーメッセージ.Caption = "登録済の商品IDを入力してください。"
        
    
    ElseIf Rownumber <> 0 Then  '既に商品が登録されている場合の処置
        
        Label_エラーメッセージ.Caption = TextBox_商品名.Value & "は登録済なので登録できません。"
           
    Else

        'シートの保護を解除
        ActiveSheet.Unprotect
        
        i = TextBox_商品ID.Value    'テーブルの行と商品IDが一致する仕様のためこのような仮定ができる。
        
        '情報の更新
        ActiveSheet.ListObjects(TableName).ListRows(i).Range(2) = TextBox_商品名.Value
        ActiveSheet.ListObjects(TableName).ListRows(i).Range(3) = TextBox_価格.Value
        
        'シートの保護
        ActiveSheet.Protect
    
    End If

End Sub