ユーザーフォームから値をセット
今回は、図のような受注伝票をユーザーフォームのリストから入力する方法を示します。
テクニックとしては、
- ユーザーフォームのリストボックスの扱い
- 検索キーワードでリストボックスの値を更新
- リストボックスで選択された値をシートへ転記
などが理解できるようになるかと思います。
動作を確認してみる
このツールでは、受注伝票を表示する「受注伝票」シートと、商品の情報を持つ「商品リスト」シートの２つのシートで構成されています。
まず準備として、「商品リスト」シートを用意して値をセットしておきます。
ユーザーフォームのリストボックスには、この値が入ることになります。
次に、「受注伝票」シートの商品選択ボタンを押すと、ユーザーフォームが表示されます。
ユーザーフォームの操作
ユーザーフォームには、検索キーワード用のテキストボックスと、商品リストを表示するリストボックスがあります。
検索キーワードに適当な文字を入れ、検索ボタンを押すと、商品名に含まれる文字を検索してリストを作り直します。
「リセット」ボタンを押すと、リストは元に戻ります。
リストの項目をどれか選択し、「値を入力」ボタンを押すと、受注伝票シートに値が転記されます。
「キャンセル」ボタンで、ユーザーフォームを閉じます。
値の入力は、ユーザーフォームを閉じない限り連続で入力することができます。
値の入力は、表の上から順に入力され、最後の行まで行くと入力できなくなるようにしています。
受注伝票シートの操作
ユーザーフォームで入力されるのは、商品コード、商品名、単価の３つです。
「数量」を入力すると、小計、合計金額が表示されます。
小計と合計金額のセルには数式マクロが入っています。
プログラミング解説
このツールでは、Module1（標準モジュール）と、UserForm1（ユーザーフォーム）の２つで構成されています。殆どのプログラムは、UserForm1に展開されています。
Module1
Module1では、商品選択ボタンを押したときに、ユーザーフォームを表示するコードがあるだけです。
Sub ボタン1_Click()
UserForm1.Show
End SubUserForm1
ユーザーフォームの部品、各オブジェクト名は以下の図を参照してください。
Label1は「検索したいワードを入力してください」と表示させています。
ボタンはそれぞれ表題の名前に揃えています。
では、プログラムコードです。
初期設定
まずはユーザーフォームの初期化部分です。
ここでは、リストボックスに値をセットしますが、リセットボタンと同じ動作なので、1つの関数にまとめてそれを呼び出しています。
SetupListという関数でリストを生成してリストボックスに値をセットしています。
’ユーザーフォームの初期化を行う
Private Sub UserForm_Initialize()
Call SetupList
End Sub
’リセットボタンをクリック
Private Sub リセットButton_Click()
Call SetupList
End SubSetupListを見ていきます。
'全てのリストを表示
Private Sub SetupList()
Dim items
With Worksheets("商品リスト")
'オートフィルターが効いていれば外す （１）
If .AutoFilterMode = True Then
.Range("A1").AutoFilter
End If
items = .Range("A1").CurrentRegion （２）
End With
With ListBox1 （３）
.ColumnCount = -1
.ColumnWidths = "20;70;30;0"
.List = items
End With
Erase items （４）
End Sub（１）で商品リストにオートフィルターが効いていれば外す処理をしています。
これは、オートフィルターが効いていると全てのリストが得られない事があるためです。
（２）の部分では、A1を含む書き込まれている範囲を二次配列として、itemsに入力しています。
itemsはVariant型で宣言されていますが、ここで二次配列がセットされます。
（３）ではリストボックスへの入力を行っています。
具体的には以下のような内容です。
With ListBox1
.ColumnCount = -1 すべての要素を含める
.ColumnWidths = "20;70;30;0" それぞれの要素の幅をセット
.List = items データの配列を指定
End With検索ボタンの処理
続いて検索ボタンの処理です。
この処理がこのツールでのキモとなります。
Private Sub 検索Button_Click()
Dim items
Dim result
Dim i As Long
Dim count As Long
If Me.検索TextBox.Text = "" Then Exit Sub '（１）
With Worksheets("商品リスト") '（２）
'オートフィルターが効いていれば外す
If .AutoFilterMode = True Then
.Range("A1").AutoFilter
End If
items = .Range("A1").CurrentRegion
End With
'---- 検索して抽出 -----（３）
ReDim result(1 To 4, 1 To 1) '項目名をセット
result(1, 1) = items(1, 1)
result(2, 1) = items(1, 2)
result(3, 1) = items(1, 3)
result(4, 1) = items(1, 4)
count = 2
For i = 1 To UBound(items) - 1
If InStr(items(i, 2), Me.検索TextBox.Text) > 0 Then '商品名で検索 '（４）
ReDim Preserve result(1 To 4, 1 To count)
result(1, count) = items(i, 1)
result(2, count) = items(i, 2)
result(3, count) = items(i, 3)
result(4, count) = items(i, 4)
count = count + 1
End If
Next i
items = WorksheetFunction.Transpose(result) '（５）
'---- 結果をリストに入力 -----
With ListBox1 '（６）
.Clear
If count = 1 Then Exit Sub
.ColumnCount = -1
.ColumnWidths = "20;70;30;0"
.List = items
End With
Erase items（７）
Erase result
End Sub（１）は、検索用のテキストボックスが空白の時、関数を終了させる処理になります。
これで、テキストボックスが空白の時は検索ボタンを押しても何も起こらなくなります。
（２）の処理は、先ほどのSetupList（）と全く同じで、一旦リストをすべてitems配列に入れています。
ただ、今回は、このitems配列から検索文字を選び出すためのリストとして使います。
（３）の冒頭部分は、項目名（商品コード、商品名、単価）をresult配列に入れています。
よく見ると、行と列を入れ替えて代入しているのがわかると思います。
これは間違いではありません。
ReDimは行方向には拡張できない
実は、「VBAでは二次配列をReDimするとき、列方向に拡張する事はできますが、
行方向には拡張できない」という仕様になっています。
下の図を見てください。
この仕様を回避するため、items配列（左）から result配列（右）に値を代入する際、行と列を入れ替えて代入しています。
こうすることで、Redimで要素を増やすことができるようになります。
Redimで要素を追加したら、元の配列に戻すため以下の関数を使います。
WorksheetFunction.Transpose(result)この関数を使って、行と列を再度入れ替えて元に戻すという事をしています。（５）
インデックスが１から始まる配列
ここで、もう一点気を付けなければならない事があります。
それは、「配列のインデックスが１から始まる」ということです。
VBAでは、配列のインデックスを１から始まるように指定するオプションがあります。
Option Base 1
この記述をモジュールの最初に書いておくと、そのモジュール内での配列は１から始まるようになります。
しかし、今回はモジュール内に「Option Base 1」の記述をしない方法を選びました。
実は、配列の宣言のときに、
result(1 To 4, 1 To 1)のように宣言することで、インデックスを１から始めるように指定できるのです。
こうすることで、インデックスを0から始めるような配列も使う事ができるようになります。
さて、このインデックスが１から始まるという仕様は、以下の部分でも影響を受けます。
items = .Range("A1").CurrentRegion
WorksheetFunction.Transpose(result)この２つは、インデックスが１から始まる配列でないとうまく機能しませんので要注意です。
文字列検索によく使われる InStr
続いて（４）の検索部分です。今回は単純に、
If InStr(items(i, 2), Me.検索TextBox.Text) > 0 Thenという処理で検索をかけています。
InStr関数は、第１引数の文字列の中に、第２引数の文字が初めて出現する文字列目を返す関数です。
もし、第２引数の文字が含まれていない時は0が返ります。
元々は、何文字目に検索キーワードが現れるかを返す関数ですが、このような書き方で、文字列が含まれるかを判断するのによく使われます。
ここで検索にヒットした行を、列方向にしてresult配列を拡張させて、配列を増やしています。
そして最後に、
items = WorksheetFunction.Transpose(result) '（５）として、行列を元に戻してitems配列にしています。
続いて（６）では、リストボックスへの入力を行っています。
With ListBox1 '（６）
.Clear
If count = 1 Then Exit Sub
.ColumnCount = -1
.ColumnWidths = "20;70;30;0"
.List = items
End Withここでは、一旦リストをクリアしています。
次に、検索結果が1つもない場合は、リストボックスを空白にして関数を終えます。
もし、検索結果が複数ある場合は配列をリストボックスに代入します。
最後に（７）で、使い終わった2つの配列を消去しています。
さて、長くなったのでここまでの要点をおさらいしておきましょう。
- VBAでは二次配列をReDimするとき、列方向に拡張する事はできますが、行方向には拡張できない
- Range.CurrentRegion や WorksheetFunction.Transpose()ではインデックスが１からの配列を使う
- result(1 To 4, 1 To 1)と宣言することでインデックスが１からの配列となる
- 「Option Base 1」をモジュールの冒頭に書けばインデックスが１からの配列となる
シートへの入力部分
次は、シートへの入力部分です。
Private Sub 入力Button_Click()
Dim i As Long
Dim ws As Worksheet
Set ws = Worksheets("受注伝票")
With ListBox1
If .ListIndex = -1 Then
MsgBox "リストボックスの項目を選択してください"
ElseIf .ListIndex = 0 Then
'リスト一行目は項目名なので無視
Else
For i = 5 To 17
If ws.Cells(i, "B") = "" Then
ws.Cells(i, "B") = .List(.ListIndex, 3) '商品コード
ws.Cells(i, "C") = .List(.ListIndex, 1) '商品名
ws.Cells(i, "D") = .List(.ListIndex, 2) '単価
Exit For
End If
Next i
End If
End With
End Sub ここでは、表の中に値を書き込んでいくため、5行目から17行目までの範囲で上から順番に入力していきます。
仕組みとしては、For分を使い5行目からB列に値があるか判断し、もし空白ならそこに値を入力して終わります。
もし、17行目まで空白がなかった場合は入力せずに終わります。
ListBox1.ListIndexには、選択している番号が入ります。
先頭が0で、何も選択されていないときは-1が返ることになっています。
今回は先頭には項目名が入っているので、先頭が選択されて入力ボタンが押された場合は何も起こらずに無視します。
ListBox1.List(.ListIndex, 1) は、第1引数が行番号（0が1番目）、第二引数が列（0が1番目）になります。
ちなみに、VBEのプロパティの、MultiSelect の項目を、0 -fmMultiSelectSingleに設定することで、複数選択ができないように設定できます。
キャンセルボタン
最後に、キャンセルボタンでユーザーフォームを閉じます。
Private Sub キャンセルButton_Click()
Unload Me
End Subお疲れ様でした
少々難しい内容だったかもしれませんが、配列の使い方の良い練習になると思いますので、是非ご自身で手を動かしてプログラムに取り組んでみてください。
ユーザーフォームの使い方は多種多様で初心者の方は大変かと思いますが、まずは基本的な使い方を覚えて少しづつ視野を広げていくようにすると良いでしょう。
長文になり、申し訳ありませんでした。最後まで読んでいただきありがとうございました。
コメント