VBA ユーザーフォームに入力したデータをセル反映(動画あり)

ユーザーフォームに入力したデータをセルに反映する方法をご紹介します。

動画で動作確認ができます👇

ユーザーフォーム作成

ユーザーフォームを作成します。

Excelシート

A列～E列の1行目に、タイトル行を入力しておきます。

マクロボタンを設置します。

以下コードを標準モジュール「Module1」に入力して、
ボタンをクリックしたときに、ユーザーフォームが開くようにします。

Sub ボタン1_Click()
    UserForm1.Show vbModeless
End Sub

マクロコードを「Module1」に入力した画面

マクロコードを入力

マクロコードを「UserForm1」に入力します。

Private Sub CommandButton1_Click()
'閉じるボタンをクリックしたときの処理
    Unload UserForm1
End Sub

Private Sub CommandButton2_Click()
'登録ボタンをクリックしたときの処理

 Dim LastRow As Long
 Dim MyOpt As String
 Dim i As Long
 
    'どのオプションボタンが選択されているかチェック
    For i = 1 To 4
        If Me.Controls("OptionButton" & i).Value = True Then
            MyOpt = Me.Controls("OptionButton" & i).Caption
        End If
    Next i
 
    'ユーザーフォームの内容をExcelに転記
    With Worksheets("Sheet1")
        '最終行にプラス1
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        
        .Cells(LastRow, 1).Value = Me.TextBox1.Text
        .Cells(LastRow, 2).Value = Me.TextBox2.Text
        .Cells(LastRow, 3).Value = Me.TextBox3.Text
        .Cells(LastRow, 4).Value = Me.ComboBox1.Text
        .Cells(LastRow, 5).Value = MyOpt
    End With
    
    '転記後は、ユーザーフォームをクリア
    Me.TextBox1.Text = ""
    Me.TextBox2.Text = ""
    Me.TextBox3.Text = ""
    
    'コンボボックスを初期値に戻す
    ComboBox1.ListIndex = 0
    
    'オプションボタンをクリア
    For i = 1 To 4
        If Me.Controls("OptionButton" & i).Value = True Then
            Me.Controls("OptionButton" & i).Value = False
        End If
    Next i
    
End Sub

Private Sub UserForm_Initialize()
'ユーザーフォーム立ち上げ時にコンボボックスに表示

  Dim Mydata As Variant
  Dim My As Variant
   
  Mydata = Array("選択してください", "A型", "B型", "O型", "AB型")
 
  For Each My In Mydata
       ComboBox1.AddItem My
  Next
   
  '初期値を選択
  ComboBox1.ListIndex = 0
    
End Sub

マクロコードを入力する場所「UserForm1」

動作

ユーザーフォームのテキストボックス・コンボボックス・オプションボタンを、入力・選択して、

「登録」ボタンをクリックします。

ユーザーフォームの値がセルに反映されます。

セルに反映された後、ユーザーフォームの各項目は初期状態に戻ります。

ユーザーフォームの値は、常に最終行に転記されます。

 
 
この記事がお役に立ちますと幸いです。
 
・【ExcelVBA】ユーザーフォーム作成の事例まとめ
 

【VBAユーザーフォーム】何ができるの？：使用例34選

...

kirinote.com

2023.03.13