エクセルVBAを始めてみましょう。第4回プログラミングの手法、Comboboxでデータを参照入力する。Sub、Functionプロシージャを作ってみる。

前回までのあらすじ
参照入力プログラムの全容
データベースの再準備。
ユーザーフォームの追加
Subプロシージャ
Functionプロシージャ
ブックを開いたときにメッセージを表示するプロシージャ
ユーザーフォームを表示させるプロシージャ
補足
全てのプログラム（練習用のエクセルファイルは下記からダウンロードできます。）
1. Excel　VBA練習帳

前回までのあらすじ

第一回目、まずはエクセル本体を起動するところから始まって、VBAのコードを書くエディターを表示させ、簡単なコードを書いてセルに文字列を表示してみました。
第二回、コードを書くにあたて基本的な用語を解説しました。そして具体的なコードの書き方もやってみました。メッセージ用のダイアログを表示させるのもやってみました.
第三回にはユーザーフォームを作って、そこにオブジェクトを配置してイベントを起こす練習をしました。文部科学省から食品栄養成分表の中から「魚介類」の約500行のデータベースもダウンロードしてコピーしました。

参照入力プログラムの全容

今回のプログラムはSheet2のB２列の任意のセルをダブルクリックしたときフォームが開きます。そこに張り付けたコンボボックスにユーザーが任意で入力した文字列でシート３のデータベースを検索して、条件に合うデータをのコンボボックスのリストに一覧表示する。さらにそのリストの中からどれか一つを選択（クリック）したら、そのデータをSheet2でダブルクリックしたセルの範囲に埋め込むという一連の作業を実行します。

このプログラムではまず最初にブックがオープンしたときにメッセージを表示することから始まります。メッセージに従ってセルをダブルクリックしたときイベントが発生してフォームが開きます。キーワードを入力してボタンをクリックするとコマンドボタンイベントが発生して一連のコードが実行されて、更にユーザーがリストを選択するとコンボボックスのクリックイベントが発生します。

この様に、VBAではイベントが発生するごとに独立したプロシージャのコードが実行されて仕事が完了する仕組みになっています。

このデータ参照入力プログラムはほんの一例にすぎませんが、様々なデータ処理の一つとして応用できるプログラムだと思います。極初心者の方々がVBAを身に着けていただいてご自分の仕事の省力化にご利用されたなら嬉しく思います。

データベースの再準備。

今回は、更にもう一つ新しいユーザーフォームを作ってそこから食品のデータベースを検索して参照入力するプログラムを作ってみたいと思います。使用するデータベースは前回と同様ですが、今回は全2000行ほどのデータを準備して、すべての食品データを検索できるようにしました。

なので第三回を参照して文部科学省から一番最後の方にある「一括ダウンロードエクセル版」をダウンロードしてsheet3に上書き貼り付けしておきます。

ユーザーフォームの追加

前回、第三回のユーザーフォームを作るを参考にして新しいフォームを作成します。そして今回はこのフォームに名前を付けます。新しいフォームが表示されている状態で、左側のプロパティーウインドウで一番上の「（オブジェクト名）」項目のところに、多分このブックでは二個目のフォームなので「UserForm2」と書かれていると思いますが、ここを適当な名前に上書きします。ここではローマ字で「kensaku」としました。私は英語は全く使えないので、いつも名前を付けるときはローマ字にしています。

そして、Captionの項目には日本語で「食材検索」としました。ここは実際にフォームが表示されたときにユーザーが目にする表示項目です。

そして、このフォームに左から順にテキストボックス、コンボボックス、ボタンをそれぞれ配置しました。配置の方法は第三回を参照ください。

テキストボックスのCaptionには「０件」、ボタンのCaptionには「検索」としました。オブジェクト名は変更なしです。

テキストボックスは隣のコンボボックスに収納されるデータの行数を表示するようにします。

コンボボックスには、ここに書き込んだキーワードを元にデータベースを検索して得たデータを収納し右側の▼をクリックするとそのデータの一覧が表示できるようにします。

ボタンは上で、キーワードを書き込んだ後クリックしたとき、データベースの検索結果をコンボボックスに収納するようにプログラムします。

Subプロシージャ

プロシージャはJavaのメソッドと言うのと同じ役割をする一連の動作をコードで記述したブロック（塊り）で、名前を付けておいて、別のプロシージャやイベントから呼び出してプログラムを形成します。

Subプロシージャは、呼び出し元から付けた名前で呼び出されて、このブロックに記述したコードを実行して、呼び出し元にもどります。（値は返さず仕事をするだけです）

呼び出し側の図は、下の例１で説明するプロシージャを呼び出す側のコマンドボタンのイベントプロシージャです。（手書きの丸1です）フォームに張り付けたボタンオブジェクトをクリックしたときに「keninput」プロシージャを呼び出しています。コンボボックスに入力された文字列を引数にしています。

（手書きの丸２）は、コンボボックスに収納された一覧リストのどれかを選択（クリック）したときのイベントプロシージャです。②でkoumokudatainプロシージャを③を引数にして呼び出しています。
④ではdatainを⑤を引数にして呼び出しています。
datain　alldata(Isbangou)ですが、入れ子になっているのでちょっと複雑ですが一番右端から見ていきます。まずIsbangouはFunctionですから呼び出されると食品番号を持ち帰っています。そのIsbangouで持ち帰った食品番号を引数にしてFunctionのalldataを呼び出しています。

alldataはデータベースで食品番号で紐づいた68個の栄養データを配列変数として持ち帰ってきます。そして最後にdatainプロシージャでそのalldataで持ち帰った配列を利用してそのデータをsheet2に表示させるという仕事をしています。

呼び出し側の図

例１
Private　Sub　keninput(str　as　String)　～～～　End　Subまでがこのプロシージャのブロックです。名前はkeninputと付けました。このプロシージャはフォームに配置したコマンドボタンをクリックしたときに呼び出されます。下図の①のstrは引数と言います。（続きのAs　Stringはこの引数は文字列型である事を宣言しています）この引数はプロシージャを呼び出す側のコードから貰ってきて（連れてきて）このプロシージャで利用します。

ここでは③の中央付近であいまい検索するときのユーザーが入力した検索キーワードをstrとして受け取って検索するコードに利用しています。

②は条件判断式で処理を分岐するIf文です。ここでの場合はstrた空白文字以外なら次の行のDo（繰り返し処理）に入ります。（逆にstrが空白文字なら繰り返し処理を実行しないでこのプロシージャの処理を終わります）

③はこのプロシージャの肝で繰り返し処理を実行してコンボボックスのリストに食品番号と食品名を★印を挟んで繋いで表示する処理です。

繰り返しの処理の中では、ユーザーが任意で入力したワードが食品名と完全に一致していなくても、その食品名の中に含まれていたときというような曖昧な条件判断によって条件式がTrueとなって、If文の次の処理であるコンボボックスのリストにアイテムを追加していきます。
アイテムには食品番号と食品名を結合していますが間に★印を挟んだのは、後からこの食品名の他の栄養成分データを取り出すための手掛かりになる食品番号を取り出しやすくするためです。

この後で説明するIsbangouというFunctionプロシージャはこの★を手掛かりに食品番号を取り出しています。

②条件分岐の使い方
If　条件式　Then
　　Aコード
　　Bコード
　　　・
　　　・
End If
次のコード最上部の条件式がTrueならAコード以降B,C,D等々を実行してEnd Ifを抜けて次のコード以降を順に実行していきます。条件式がFalseならA以降のコードは一つも実行せずにEnd Ifを抜けて次のコード以降を実行します。条件式の例
str　<>　””　これは変数strが未定義（空白文字）以外であればTrueとなる式です
逆に言うと変数strに何も文字列が入っていなければFalseとなります。str　＝　”たこ”　この式で変数strに「たこ」が入っていればTrueです。
変数strに「いか」が入っていればFalseになります。If、条件分岐文の書き方は他にも幾通りもあります。ここでは一番単純な書き方だけ説明しますから、あとはご自分で調べてください。

繰り返し処理　Do　~　Loop　の使い方
Do
　　Aコード
　　Bコード
　　・
　　・
　　Eコード
Loop
次のコード
・
解説
Aコードから始まって～Eコードまで実行したら、Aコードに戻って～Eコードを実行したら、Aコードに戻って～・・・・・と何度も繰り返します。
しかし、残念ながら上のこのループ処理は無限ループになりこの処理でCPUを占有してしまうためPC本体がフリーズ状態になってしまいます。結果としてPCを再起動しなければならなくなります。（再起動しなくても[Esc]キーを押すと中断できるようです。知らなかった(><;)　）その為、適当な状態になったら繰り返しを終了するようにキーワードを付けた条件式を書きます。ここで使用している例では、Until（アンティル）キーワードを使っています。
Untilは条件式がTrueになるまで処理を続けるという意味になります。Dim　ｒ　As　Integer
Do
　　Textbox1.Text　= 　ｒ　　‘テキストボックスに０を表示
　　ｒ　=　r　+　1　　　　　‘ｒに1を加算
Loop　Until　ｒ　=　100　　　‘ｒが100になるまで繰り返しを続けます。
次のコード
・
・
上のループ処理では最初の繰り返しでテキストボックスに０を表示して二回目の繰り返しで１を加算して表示します。その後も繰り返すごとに１を加算して表示し続けます。このコードは結果としてテキストボックスに99を表示したところで繰り返しを終了して、次のコードに処理を移します。条件式を設定するキーワードには、ほかにWhileというのがあります。Whileは条件式がTrueである間、処理（繰り返し）を続けるという意味になります。ほかに、If文(条件分岐)を使って条件式がTrueになったらExit Doをつかって繰り返しを終了する書き方もあります。いずれにしても繰り返しの中で繰り返しを終了させるコードを書くのを忘れないようにしなければいけません。
又、このDo～Loopはあらかじめ繰り返す回数がわからない時に使用しますが、最初から回数がわかっているときはFor～Nextを使ったほうがいいです。

例２
Private　Sub　datain(rowdata　as　Variant)　～～～　End　Sub
このプロシージャは下図の青ラインで表したセル範囲に、引数にした配列変数の栄養データを入れ込む作業をするプロシージャです。

手書きの丸１はclomsuuはFunctionでデータベース範囲の列数を持ち帰ります。（栄養データをシートに埋め込む位置の関係で２を引く作業をしています。）

Functionプロシージャ

Functionプロシージャは特殊なプロシージャで、これも名前で呼び出し元から呼び出すとそのブロックでコードを実行した結果の値を呼び出し元へ持ち帰ることが出来ます。（これを値を返すと表現します）いわゆるユーザー定義関数というやつです。

①はIsbangouというFunctionです。コンボボックスでリストがクリックされたときのイベントプロシージャから呼び出されます。このリストで選択されたリストの項目名の中に含まれる食品番号を取り出して、呼び出し元へ返します。

まず、クリックされたリストの項目名を取り出します。次の行で★印の位置を調べて次の行で先頭から★印の一つ手前までを取り出しています。食品番号は桁数がわからないので★印を手掛かりにしています。呼び出し元はコンボボックスのリストをクリックしたときのプロシージャなので、Isbangouを呼び出すときにリストの項目名を引数に設定してもいいのですが、Functionの解説、説明のための例としてこのような形にしました。

②はalldataというFunctionです。同じくコンボボックスでリストがクリックされたときのイベントプロシージャから呼び出されます。①で返った食品番号を引数にして、その食品番号に紐づいた栄養成分データを配列変数に格納して返ってくるプロシージャです。

allataは食品番号を引数にして呼び出されます。Do繰り返し処理の中で条件分岐の条件式のなかで、データベースの食品番号と引数の食品番号と一致したときのそ食品の栄養成分データのセル範囲を取り出します。そしてこのプロシージャ名にデータを格納して、次の行で繰り返しを抜け出して呼び出し元へ戻ります。

以上の様にSub、Functionが一つ一つのプロシージャとしてブロックごとに簡潔していて各所から呼び出されて実行されていく仕組みになっています。プロシージャを呼び出すきっかけになるイベントはVBAが自動的に生成する仕組みになっています。

①のwithの使い方
「.」ピリオド以前、オブジェクト名を省略します。
str = ComboBox1.List(ComboBox1.ListIndex)　→　これはコンボボックスのリストをクリックしたときのインデックスをリストの項目名に文字列変換して変数strに格納するコードです。このコードの中にはComboBox1というオブジェクト名が2個使われていますが、非常に見通しがわるいです。そこで、これにwithを使い省略して書くと次の様になります。With　ComboBox1
　　str = .List(.ListIndex)
End Withどうでしょう。全体の字数には変わりありませんが見通しが大変よくなりました。
複数のコードの中に同じオブジェクトが3個、4個と出てくる場合はなおさら有効な書き方です。

下図の①のファンクションプロシージャは配列変数になっていて、Sheet3にある栄養成分データのセル範囲を格納して呼び出し元へ持ち帰ります。
セル範囲右側の青ライン.Cells( 8 , colmsuu )の中のcolmsuuは②で、栄養成分データ領域の列数を返すファンクションプロシージャを呼び出して、列数（68）を持ち帰っています。

この列数を返すcolmsuuは他のプロシージャのコードからも何度も呼び出しています。
この様にブロックごとに簡潔したプログラムを組合せて、各所から呼び出すことで効率のよいプログラムを作ることができるようになります。

ブックを開いたときにメッセージを表示するプロシージャ

ユーザーフォームを表示させるプロシージャ

補足

イベントプロシージャのコードは自動的にVBAが発行します。

フォームに張り付けたボタンを選択状態にしてダブルクリックするとコードエディターに自動的に書き込まれます。そしてエディターの上部を見ると左右に並んだボックスの左側はCommandbutton1となって、右側にはClickとなっています。これが１のコードに現れています。

この右側のボックスの右端にある▼をクリックすると利用できるイベントの一覧が表示されるので、発生するイベントを選ぶことが出来るようになっています。

全てのプログラム（練習用のエクセルファイルは下記からダウンロードできます。）

Excel　VBA練習帳

1 ファイル 940.84 KB

ダウンロード

Private Sub CommandButton1_Click()
    'コンボボックスに入力されたテキストを使ってSeet3の食材を検索してリスト表示させる
     '--------------------------------------
     keninput ComboBox1.Text
End Sub

Private Sub ComboBox1_Click()
    'コンボボックスのリストに表示されている食材リストのどれかがクリックされたときの処理
    '--------------------------------------
    
    Sheet2.Activate　　　　　　’シート２をアクティブにします。
    Dim c As Integer: c = 2　　’整数型の変数ｃを宣言して初期値２を代入します
    
    '項目行があるか調べて、なければ書き込む
    If Cells(2, 1) = "" Then
        koumokudatain koumokudata
    End If
    
    'リストが選択（クリック）されたときそのリストの項目名に含まれる食品番号から
    'sheet3にあるその行のデータを取り出してsheet2に書き出す
    datain (alldata(Isbangou))  'Isbangou→リスト項目左端の食品番号を取り出す
    
    'フォームを閉じる
    Unload Me

End Sub

'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'＊＊＊＊＊＊＊＊＊＊　Subプロシージャ（値を返さない）＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊

Private Sub keninput(str As String)
    'コンボボックスに入力した検索ワードstrでSheet3の食材データを検索して
    '結果をコンボボックスのリストに入れる
    '-----------------------------------------------------
    Dim gyou As Integer
    Dim syokuzai As String
    Dim syokuID As Integer
    
    gyou = 9    'Sheet3を検索開始する行
    
    ComboBox1.Clear     '前回までのリストを消しておく
    
    Label1.Caption = "0 件"  '検索件数を表示
    
    If str <> "" Then       '検索ワードが未定義以外（入力されている）なら検索を開始
    
        Do
            syokuzai = Sheet3.Cells(gyou, 4).Value  '食品名をセット
            syokuID = Sheet3.Cells(gyou, 2).Value   '食品番号をセット
            
            If syokuzai Like "*" & str & "*" Then   '食品名をあいまい検索
            
                '検索結果がtrueならコンボボックスのリストにアイテムを追加する
                ComboBox1.AddItem syokuID & "★" & syokuzai '食品番号＋★＋食品名
                
            End If
        
            gyou = gyou + 1         '次の行を指定する
        
        Loop Until syokuzai = ""    '食材名が未定義になるまで繰り返しを継続
        
        'コンボボックスのリストをドロップダウンして表示させる
        ComboBox1.DropDown
        
        'リストに追加されたアイテムの総数を表示
        Label1.Caption = ComboBox1.ListCount & " 件"
    End If
    
    
End Sub

Private Sub datain(rowdata As Variant)
    '配列rowdataのデータをシートのセルに書き込むプロシージャ
    '------------------------------------------
    Sheet2.Activate
    Dim retusuu As Integer
    
    retusuu = colmsuu - 2
    
    'セル範囲に配列を一気に流し込むやり方。
    Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, retusuu)) = rowdata
    
    
    '繰り返し処理を使って、配列から一個一個データを取り出してセルに書き込むやり方。
    'Dim retu As Integr
    'For retu = 0 To (colmsuu)
    '    ActiveCell.Offset(0, retu) = rowdata(1, retu + 1)
    'Next
End Sub

Private Sub koumokudatain(koumokudata)
    '配列koumokudataの項目データ4行分を書き込むプロシージャ
    '-----------------------------------------------
    Sheet2.Activate
    
    Range(Cells(1, 2), Cells(4, colmsuu)) = koumokudata
End Sub

'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'＊＊＊＊＊＊＊＊＊＊　Function プロシージャ（値を返す関数）＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊

Private Function Isbangou() As Integer
    'リストを選択したとき食品番号を整数で返す
    '---------------------------------------
    Dim str As String
    Dim syokuNumb As Integer
    Dim idx As Integer
    
    With ComboBox1
    
        str = .List(.ListIndex)     '選択したリスト項目名を取り出す
        idx = InStr(str, "★")      '取り出した項目名に含まれる★の文字位置を調べる
        syokuNumb = Mid(str, 1, idx - 1)    '★位置を手掛かりに食品番号を取り出す
        
    End With
   
    Isbangou = syokuNumb
    
End Function

Private Function alldata(numba As Integer) As Variant
    'シート３のデータベースをnumbaで検索してその行の全データを配列で返す
    '------------------------------
    Dim r As Integer: r = 9
    Dim i As Integer
    
    With Sheet3
        
        Do
        
            If .Cells(r, 2) = numba Then    '食品番号の列のデータがnumbaと一致したら
                
                'その行のデータ範囲を配列に格納して繰り返しをやめる
                alldata = .Range(.Cells(r, 2), .Cells(r, colmsuu))
                Exit Do
                
            End If
            
            r = r + 1   'その行のデータが一致しなければ次の行を調べる
            
        Loop Until .Cells(r, 2) = ""    '食品番号の列が未定義になるまで繰り返す
        
    End With
End Function

Private Function koumokudata() As Variant
    'シート３のデータベースの項目部分５行－８行の全データを配列にして返す
    '------------------------------
    
    With Sheet3
        '配列に項目部分のセル範囲データを格納
        koumokudata = .Range(.Cells(5, 2), .Cells(8, colmsuu))
    End With
End Function

Private Function colmsuu() As Integer
    'Sheet3のデータベースの領域から列数を取り出して返す
    '-----------------------
    colmsuu = Sheet3.Range("A9").CurrentRegion.Columns.Count
    
End Function

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

Private Sub CommandButton1_Click()

'コンボボックスに入力されたテキストを使ってSeet3の食材を検索してリスト表示させる

'--------------------------------------

keninput ComboBox1.Text

End Sub

Private Sub ComboBox1_Click()

'コンボボックスのリストに表示されている食材リストのどれかがクリックされたときの処理

'--------------------------------------

Sheet2.Activate　　　　　　’シート２をアクティブにします。

Dim c As Integer: c = 2　　’整数型の変数ｃを宣言して初期値２を代入します

'項目行があるか調べて、なければ書き込む

If Cells(2, 1) = "" Then

koumokudatain koumokudata

End If

'リストが選択（クリック）されたときそのリストの項目名に含まれる食品番号から

'sheet3にあるその行のデータを取り出してsheet2に書き出す

datain (alldata(Isbangou)) 'Isbangou→リスト項目左端の食品番号を取り出す

'フォームを閉じる

Unload Me

End Sub

'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊

'＊＊＊＊＊＊＊＊＊＊　Subプロシージャ（値を返さない）＊＊＊＊＊＊＊＊＊＊＊＊＊＊

'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊

Private Sub keninput(str As String)

'コンボボックスに入力した検索ワードstrでSheet3の食材データを検索して

'結果をコンボボックスのリストに入れる

'-----------------------------------------------------

Dim gyou As Integer

Dim syokuzai As String

Dim syokuID As Integer

gyou = 9 'Sheet3を検索開始する行

ComboBox1.Clear '前回までのリストを消しておく

Label1.Caption = "0 件" '検索件数を表示

If str <> "" Then '検索ワードが未定義以外（入力されている）なら検索を開始

syokuzai = Sheet3.Cells(gyou, 4).Value '食品名をセット

syokuID = Sheet3.Cells(gyou, 2).Value '食品番号をセット

If syokuzai Like "*" & str & "*" Then '食品名をあいまい検索

'検索結果がtrueならコンボボックスのリストにアイテムを追加する

ComboBox1.AddItem syokuID & "★" & syokuzai '食品番号＋★＋食品名

End If

gyou = gyou + 1 '次の行を指定する

Loop Until syokuzai = "" '食材名が未定義になるまで繰り返しを継続

'コンボボックスのリストをドロップダウンして表示させる

ComboBox1.DropDown

'リストに追加されたアイテムの総数を表示

Label1.Caption = ComboBox1.ListCount & " 件"

End If

End Sub

Private Sub datain(rowdata As Variant)

'配列rowdataのデータをシートのセルに書き込むプロシージャ

'------------------------------------------

Sheet2.Activate

Dim retusuu As Integer

retusuu = colmsuu - 2

'セル範囲に配列を一気に流し込むやり方。

Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, retusuu)) = rowdata

'繰り返し処理を使って、配列から一個一個データを取り出してセルに書き込むやり方。

'Dim retu As Integr

'For retu = 0 To (colmsuu)

' ActiveCell.Offset(0, retu) = rowdata(1, retu + 1)

'Next

End Sub

Private Sub koumokudatain(koumokudata)

'配列koumokudataの項目データ4行分を書き込むプロシージャ

'-----------------------------------------------

Sheet2.Activate

Range(Cells(1, 2), Cells(4, colmsuu)) = koumokudata

End Sub

'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊

'＊＊＊＊＊＊＊＊＊＊　Function プロシージャ（値を返す関数）＊＊＊＊＊＊＊＊＊＊＊＊＊＊

'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊

Private Function Isbangou() As Integer

'リストを選択したとき食品番号を整数で返す

'---------------------------------------

Dim str As String

Dim syokuNumb As Integer

Dim idx As Integer

With ComboBox1

str = .List(.ListIndex) '選択したリスト項目名を取り出す

idx = InStr(str, "★") '取り出した項目名に含まれる★の文字位置を調べる

syokuNumb = Mid(str, 1, idx - 1) '★位置を手掛かりに食品番号を取り出す

End With

Isbangou = syokuNumb

End Function

Private Function alldata(numba As Integer) As Variant

'シート３のデータベースをnumbaで検索してその行の全データを配列で返す

'------------------------------

Dim r As Integer: r = 9

Dim i As Integer

With Sheet3

If .Cells(r, 2) = numba Then '食品番号の列のデータがnumbaと一致したら

'その行のデータ範囲を配列に格納して繰り返しをやめる

alldata = .Range(.Cells(r, 2), .Cells(r, colmsuu))

Exit Do

End If

r = r + 1 'その行のデータが一致しなければ次の行を調べる

Loop Until .Cells(r, 2) = "" '食品番号の列が未定義になるまで繰り返す

End With

End Function

Private Function koumokudata() As Variant

'シート３のデータベースの項目部分５行－８行の全データを配列にして返す

'------------------------------

With Sheet3

'配列に項目部分のセル範囲データを格納

koumokudata = .Range(.Cells(5, 2), .Cells(8, colmsuu))

End With

End Function

Private Function colmsuu() As Integer

'Sheet3のデータベースの領域から列数を取り出して返す

'-----------------------

colmsuu = Sheet3.Range("A9").CurrentRegion.Columns.Count

End Function

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    'ダブルクリックするセルの列を2列目で、かつ5行目以降に限定します
    If Target.Column = 2 And Target.row >= 5 Then
    
        'フォームが開く位置をダブルクリックしたセル位置の右側に調整
        kensaku.Top = Target.Top + 100
        kensaku.Left = Target.Left + 150
        kensaku.Show
        
    End If
    
    'ダブルクリックしたセルが編集状態になるのをキャンセルする
    Cancel = True
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

'ダブルクリックするセルの列を2列目で、かつ5行目以降に限定します

If Target.Column = 2 And Target.row >= 5 Then

'フォームが開く位置をダブルクリックしたセル位置の右側に調整

kensaku.Top = Target.Top + 100

kensaku.Left = Target.Left + 150

kensaku.Show

End If

'ダブルクリックしたセルが編集状態になるのをキャンセルする

Cancel = True

End Sub

Private Sub Workbook_Deactivate()
'入力範囲の色をもとに戻す
Sheet2.Range(Cells(5, 2), Cells(50, 2)).ClearFormats
End Sub

Private Sub Workbook_Open()
'シート２を選択状態にしてB列をダブルクリックするよう促す

MsgBox "Bの列でダブルクリックすると参照入力ができます"

'入力範囲がわかるように5行目以降だがとりあえず50行目まで薄い黄色にする
Sheet2.Activate
Sheet2.Range(Cells(5, 2), Cells(50, 2)).Interior.Color = RGB(255, 255, 200)
Sheet2.Cells(5, 2).Select
End Sub