【VBA】UserForm(ユーザーフォーム)のリスト活用事例

こんにちは、Ryoです。
Excelで顧客や品番管理を行っていると、多種多様で取り扱いに困ることもありますよね。
私も会社で取り扱う客先情報や品番が相当数あり、都度入力や追加したりする作業がかなり
煩わしいのでVBAのUserForm(ユーザーフォーム)を補助的に使用して手間を省いてます。

客先と品番がまとめられているシートがあれば、その情報を使ってUserFormのリストに表示して任意の品番を選択~セルに書き込んだり、新規客先や品番があればUserFormに入力してデータがまとめられているシートに自動的に追加させたり出来ますので、今回はその活用事例についてご紹介したいと思います。



1.サンプル概要

◆①データを読みFormのリストボックスに一覧表示する

先ず画像のシートは「Extract」という名前にしています。
セル内の【客先】の下の欄は「入力規則」で別シートの客先データをリスト表示しますが、
そのリストから客先を選択した際にUserFormが表示され、Form内のリストボックスに別
シートに入力された品番データを一覧で表示します。
表示された品番を選択し「OK」を押すと【品番】の下のセルに書き込まれるものです。

◆②新規客先や品番を追加する

シート内に配置した「客先・品番登録」ボタンを押すとUserFormが表示され、リストボックスには開く際に読み込んだ登録済み客先一覧があります。

既存の客先に品番を追加する際は「反映⇒」で既存の客先を選択し追加したい品番を本差プルでは3つまで書き込めます。

新規に客先を登録したい場合は、直接【客先】欄と品番を書き込むことで、データがある
シートに追加するものです。

今回はこの①、②のサンプルについて解説していきます。

2.準備事項

本サンプルの動作概要は上述の通りですが、実行する為の前提条件として、

「DATA」という名前のシートに上の様な形で客先・品番データがあることとしています。
又、本シートの客先データを使って「データ入力規則」を使用します。

元の値に入力されている数式は以下になります。

=OFFSET(DATA!$B$9,0,0,COUNTA(DATA!$B$9:$B$23),1)

OFFSETとCOUNTAを使用するのは、DATAシートの指定範囲から空白を除いてリスト表示する為のものです。

詳細な説明は割愛しますが、OFFSET(基準, 行数, 列数, 高さ, 幅)で、基準とした
セルから指定行数と列数だけシフトした位置の高さと幅の「セル範囲」を返す関数なので、
COUNTAを使って指定範囲の空白ではないセルの個数をカウントし、OFFSET関数の高さを
指定することで空白を除外しています。

。。。ここまで書いておいて何ですが、別に空白除去しなくてもサンプルコード動きますから面倒な時は普通に入力規則の種類をリストにして元の値を=DATA!$B$9:$B$23としても
大丈夫です。

後はサンプル②で使用する「客先・品番登録」ボタンを作って配置しておけばOKです。

3.サンプル①解説

シート内に設定した入力規則のリストで客先を選択した際にUserFormを表示させる為に、
エディタ画面のプロジェクトウィンドウで「Extract」と名前を付けたシートをダブルクリックして以下のコードを記述します。

Private Sub Worksheet_Change(ByVal Target As Range)

 Dim Exlow As Long
 Dim ExCol As Integer

  ExRow = Target.Row
  ExCol = Target.Column
 
 If ExRow = 4 And ExCol = 2 And Cells(4, 2) <> "" Then  
      UserForm1.Caption = "品番抽出"
      UserForm1.Show vbModeless
  End If

End Sub

このコードで実行しているのは、ターゲットとするセルに変化があった場合に
UserForm1を表示させるというものです。

本サンプルではセルB4(Cells(4,2))になりますから、ターゲットとした

ExRow = Target.Row
ExCol = Target.Column

この部分でExRowが4、ExColが2となり、且つ空白でなければ処理が自動的に実行され、
UserForm1が表示されます。

そのUserForm1は以下の様な形になります。

UserForm1のサンプルコードは以下の通りになります。

Private Sub UserForm_Initialize()
 'UserFormの表示位置やサイズ調整用
    Me.StartUpPosition = 0
    Me.Left = 400
    Me.Top = 180
    Me.Height = 200
    Me.Width = 330

    Call CommandButton1_Click

End Sub
’----------------------
Private Sub CommandButton1_Click()

    Dim i As Long
    Dim tgt As Variant
    Dim Sh_Name, Cust As String

    Sh_Name = ActiveSheet.Name
    ListBox1.Clear
 
    For Each tgt In Range("B:B")
         If tgt = "【客先】" Then
            tgt.Select
            Cust = ActiveCell.Offset(1, 0)
            Exit For
         End If
    Next

    Application.ScreenUpdating = False
    Worksheets("DATA").Select
  'シート内からメイン画面の客先情報と一致するセル検索
   For Each tgt In ActiveSheet.UsedRange
     If tgt = Cust Then
        tgt.Select
         '見つけたら品番データをUserFormのリストボックスへ
          For i = 1 To 5
            If ActiveCell.Offset(0, i) <> "" Then
                 ListBox1.AddItem ActiveCell.Offset(0, i)
             Else
                 Exit For 'データ無しでループ抜け
            End If
          Next i
          
        Exit For '見つけたら用済みの為ループ抜け
        
     End If
   Next

   Worksheets(Sh_Name).Activate
   Application.ScreenUpdating = True

End Sub
’------------------------
Private Sub CommandButton2_Click()

   If ListBox1.ListIndex = -1 Then
      MsgBox "品番を未選択です", vbCritical
     Else
      For Each tgt In Range("B:B")
         If tgt = "【品番】" Then
            tgt.Select
             ActiveCell.Offset(1, 0) = ListBox1.Text
            Exit For
         End If
      Next
   End If

End Sub
’-------------------------
Private Sub CommandButton3_Click()

 Unload UserForm1

End Sub

UserForm_Initialize()では表示した際のサイズや表示位置を調整する為の記述をしています。
ここの数値はお好みで変えても大丈夫です。
表示すると同時にCallでCommandButton1_Click()を実行させます。

CommandButton1_Click()は客先情報を読み込み、DATAシートを検索して一致した位置から品番データを読み込み、 ListBox1.AddItemを使ってリスト化します。

CommandButton2_Click()は一覧表示された品番データを選択して、対象ボタンを押すことでサンプルのセルB9に品番データを書き込む処理をします。

CommandButton3_Click()はFormを閉じる処理になります。

特に難しい処理は無く、覚えておくと便利なのは指定したセルが書き換わると自動的に処理が実行されるWorksheet_Change(ByVal Target As Range)や、Formのリストに関する
ListBox1.AddItem・・・ですね。

後は本サンプルで無理に使う必要がないFor Eachですが、何かと有用なので使い方の参考になればと思い敢えて使ったりしてます(笑)
For Eachは以前のこちらの記事でも紹介していますので、ご参考までに。

4.サンプル②解説

こちらで使用するUserFormは以下になります。

サンプルコードはこの通りです。

Private Sub UserForm_Activate()
  'Form表示する際に既に登録されている客先データを読み込む
    Dim i As Long
    Dim tgt As Variant
    Dim Sh_Name, Cust As String

    Sh_Name = ActiveSheet.Name
    ListBox1.Clear
   
    Application.ScreenUpdating = False
    Worksheets("DATA").Select

    For Each tgt In ActiveSheet.UsedRange
       If tgt = "客先" Then
           tgt.Select
          For i = 1 To 15
              If ActiveCell.Offset(i, 0) <> "" Then
         'ここでリスト化する
                 ListBox1.AddItem ActiveCell.Offset(i, 0)
               Else
                 Exit For
               End If
           Next i
         Exit For
       End If
    Next

    Worksheets(Sh_Name).Activate
    Application.ScreenUpdating = True

End Sub
'-------------------------------
Private Sub CommandButton1_Click()

  Dim tgt As Variant
  Dim cnt, i, NumA, NumB, addflg As Integer
  Dim Target, Sh_Name、Cell_Ad As String
  Dim Model(1 To 3) As Variant
  Dim MyRow, MyCol As Long

  Sh_Name = ActiveSheet.Name
  Application.ScreenUpdating = False
  Worksheets("DATA").Select

  For i = 1 To 3 'Form品番データが空欄じゃなければ読み込む
     If UserForm2.Controls("TextBox" & i + 1).Value <> "" Then
         Model(i) = UserForm2("TextBox" & i + 1).Value
         cnt = cnt + 1
     End If
  Next i

  Target = Me.TextBox1  '客先=Target

  For Each tgt In Range("B8:B23")
    Select Case tgt
       '客先を探すのは新規登録の際に空きの場所を特定する為
       Case Is = "客先"
         tgt.Select
         MyCol = ActiveCell.Column
         NumA = WorksheetFunction.CountA(Range(Cells(9, MyCol), _
         Cells(23, MyCol)))
       
         If NumA = 15 Then
             MsgBox "客先欄に空きがありません", vbCritical
             Exit Sub
           Else
             Cell_Ad = ActiveCell.Offset(NumA + 1, 0).Address _
             (RowAbsolute:=False, ColumnAbsolute:=False)
         End If

       Case Is = Target
          tgt.Select
          MyRow = ActiveCell.Row
          addflg = 1
          For i = 1 To cnt
              NumB = WorksheetFunction.CountA(Range(Cells(MyRow, 3), _
              Cells(MyRow, 7)))
                If NumB = 5 Then
                    MsgBox "入力可能なセルがありません", vbCritical
                    Exit Sub
                 Else
                    ActiveCell.Offset(0, NumB + 1) = Model(i)
                End If
          Next i
          
       End Select    
  Next

  If addflg <> 1 Then
      Range(Cell_Ad).Select
      ActiveCell = Target
        For i = 1 To cnt
           ActiveCell.Offset(0, i) = Model(i)
        Next i
  End If
     
  Worksheets(Sh_Name).Activate
  Application.ScreenUpdating = True
  MsgBox "登録完了", vbInformation
  Unload UserForm2

End Sub
'-------------------------------
Private Sub CommandButton2_Click()

  Unload UserForm2

End Sub
'-------------------------------
Private Sub CommandButton3_Click()

 If ListBox1.ListIndex = -1 Then
    MsgBox "客先を未選択です", vbCritical
  Else
     TextBox1 = ""
     TextBox1 = ListBox1.Text
 End If

End Sub

先ずUserForm2を表示する際に登録済みの客先データを読み込むので、その処理内容が
UserForm_Activate()に記述した内容ですが、サンプル①の処理とほぼ同様ですね。

CommandButton1_Click()の処理ですが、ここで覚えておくと後々助かる部分としてFormに配置したテキストボックスの空判定です。

If UserForm2.Controls(“TextBox” & i + 1).Value <> “” Then

この様に記述していますが、UserForm2.Controls(“TextBox”・・・と書くことで成立して、他の記述の仕方(例えばIf TextBox1 <>”” Then・・・やIsEmptyなど)では上手く判定できませんでしたので、こうしています。

後はFor Eachで検索して、新規に客先を追加する場合のセルアドレス取得と客先の登録有無をチェックして有ればテキストボックスに記載された品番を書き込む処理を行っています。
範囲指定はシート全体だったりセル範囲だったりしてますが、ここは意図的に指定方法を変えているので、やり方の参考になればと思った次第です。

CommandButton2_Click()はキャンセル対応、CommandButton3_Click() は客先指定されていない場合の警告表示処理となっています。

◆使用例

本サンプルで例えばM社を追加して品番M001,M002を追加する場合は、

「客先・品番登録」ボタンを押してFormを表示し、画像の通り入力して「実行」を押すと、

登録完了のダイアログが表示され、DATAシートを見るとこの通り登録されますので、ここでサンプル①で設定した入力規則で見ると存在しています。

そのM社を選択すれば、サンプル①のFormが表示され、品番が選択できます。

このような形になりますので、普段まとめて管理しているデータシートなどを上手く活用することが出来るのではないかと思います。



以上がUserFormのリスト活用事例になります。
書き始める前はもっとあっさり書くつもりでしたが、気が付けば長くなりました。。。
会社で扱う製品や仕組みによって様々ですからうまくマッチして使えるものではないと思いますが、何かの参考になれれば幸いです。

Ryo

スポンサーリンク
スポンサーリンク

楽天トラベル

シェアする

フォローする

スポンサーリンク

楽天トラベル