【ExcelマクロVBA】抽出したデータをリストボックスで表示させるマクロ

質問

Excelであるセルに入力したデータを別シートから抽出して、別セルにリストボックスで表示させる方法が分らなくて悩んでいます。
例えば、下のような価格表があって
　　<A列>　<B列>　<C列>
1　りんご　A店 　100円
2　りんご　B店 　 90円
3　すいか　A店　 950円
4　すいか　C店 800円
5　みかん　D店　 100円
　・　　・　　　・
　・　　・　　　・
入力シートが別シートにあり、
　　<A列>　<B列>　<C列>
1
2
3
セルA1へ例えば「すいか」を入力（リストボックスから選択できるようにしてあります）した場合、B1は「A店」か「C店」のみが、C1は「950円」か「800円」のみを選択できるようなマクロを作りたいと思っています。この価格表は流動的で毎日更新されています。A列の品名は絶えず更新し、C列の価格も変動しているのでLookupなどの関数では無理ではと思っていますがマクロだと可能でしょうか？
なお、この入力シートを別シートへ転記させて活用するつもりで
入力ミスや空欄をチェックさせて転記を中断（MsgBox等）させたいのですが、セル指定で判断させるのではなく（A列を全て埋める必要はありません）、例えばA1に品名が入力した場合、1行目の該当セル（記入必須項目）の空欄が無いこと・入力が正しいかをチェックする様な条件分岐のマクロ記述方法を教えてください。
説明が拙いかと存じますが、宜しくお願いします。

回答No.2

pauNed

こんにちは。
価格表のシート名が『Sheet1』だとします。
入力用のシートの『A1セルを選択して』[Ctrl]キー+[F3]キー同時押し。
　　　　　　　　　~~~~~~~~~~~~~~~~~~~（重要。とにかく１行目）
[名前の定義]で以下設定。

名前：　BLIST
参照範囲：　=OFFSET(Sheet1!$A$1,MATCH(!$A1,Sheet1!$A:$A,0)-1,1,COUNTIF(Sheet1!$A:$A,!$A1))

名前：　CLIST
参照範囲：　=OFFSET(Sheet1!$A$1,MATCH(!$A1,Sheet1!$A:$A,0)-1,2,COUNTIF(Sheet1!$A:$A,!$A1))

これで可変のリストができますから
入力用のシートのB列に[入力規則]のリスト　元の値：　=BLIST
入力用のシートのC列に[入力規則]のリスト　元の値：　=CLIST

...というように、基本的には一般機能でも可能です。
ただし、価格表がA列を基準に並び替えられている事が前提なので
Sub auto_open()
　　With Sheets("sheet1")
　　　　.Range("A1").CurrentRegion.Sort Key1:=.Range("A1"), _
　　　　　　　　　　　　　　　　　　　　Order1:=xlAscending, _
　　　　　　　　　　　　　　　　　　　　Header:=xlNo, _
　　　　　　　　　　　　　　　　　　　　OrderCustom:=1, _
　　　　　　　　　　　　　　　　　　　　MatchCase:=False, _
　　　　　　　　　　　　　　　　　　　　Orientation:=xlTopToBottom, _
　　　　　　　　　　　　　　　　　　　　SortMethod:=xlStroke
　　End With
End Sub
など、Bookを開いた時に自動で『Sheet1』を並び替えるマクロを設定しておく必要があります。
もしくは『Sheet1』のシートモジュールのPrivate Sub Worksheet_Deactivate()に設定します。

>入力ミスや空欄をチェックさせて転記を中断
入力直後にイベントプロシージャを使って１行ごとに転記するのでしょうか。
その辺り詳細不明なので、まとめて転記する場合の
>条件分岐のマクロ記述方法
サンプルのみ書いておきます。

Sub sample1()
　　Dim msg As String
　　Dim r　 As Range

　　On Error GoTo errHndr
　　With Range("A1", Cells(Rows.Count, 1).End(xlUp))
　　　　If WorksheetFunction.CountA(.Offset(, 1)) < .Count Then
　　　　　　msg = "未入力セルあり。"
　　　　Else
　　　　　　For Each r In .Offset(, 2).Cells
　　　　　　　　If Not IsNumeric(r.Value) Then
　　　　　　　　　　msg = "Not数値セルあり。"
　　　　　　　　　　Set r = Nothing
　　　　　　　　　　Exit For
　　　　　　　　End If
　　　　　　Next r
　　　　End If
　　　　If Len(msg) = 0& Then
　　　　　　.Resize(, 3).Copy
　　　　　　Sheets("転記先シート").Cells(Rows.Count, 1) _
　　　　　　　　.End(xlUp).Offset(1).PasteSpecial Paste:=xlValues
　　　　　　Application.CutCopyMode = False
　　　　Else
　　　　　　MsgBox msg & "転記中断"
　　　　End If
　　End With
errHndr:
　　With Err
　　　　If .Number <> 0 Then
　　　　　　Debug.Print .Number & ":" & .Description
　　　　　　MsgBox .Number & ":" & .Description
　　　　End If
　　End With
End Sub

回答No.1

imogasi

これはプチ課題の丸投げですね。
（１）質問の文章は長いが、入力シート（Sheet1と仮定して）に数件入力した時の後の姿が書かれていないので判りにくい。このほうが自然だろうと推定でやった。
（２）リストボックスはコンボでやった。
クリックする前は、大きさが１行で済むのでこの方が良かろうかと思った。（オブジェクトをリストボックスを貼り付けにして、下記コードでCombox1をlistBox1に置き換えると動くと思う。）
ーー
全般に簡単そうに見えるが、質問者のレベルでは、荷が重いのでは。
色々な課題が諸所に散らばっていると思うが、相当時間をかけないと
（まねすれば早いが）独力では、使えないもののようにおもう。
ーー
例データ
Sheet2　A2:C10
りんご A店 100
りんご B店 90
すいか A店 950
すいか C店&nbsp;&nbsp; 800
みかん D店 100
すいか E店 800
バナナ F店 200
すいか G店 750
みかん G店 200
Sheet1
コンボボックスを１つ張り付け。高さは１セル分。幅は２列データが
出せるぐらい。D列あたりに配置。
ーー
コード
標準モジュールに
Public tg As Range
　　－－
Sheet1のイベント・プロシに
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
Set tg = Target
Dim sh1 As Worksheet
Dim sh2 As Worksheet
'--
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
' --
d = sh2.Range("A65536").End(xlUp).Row
ComboBox1.Clear
ComboBox1.Top = tg.Offset(0, 2).Top
'---
For i = 2 To d
If Target = sh2.Cells(i, "A") Then
s = sh2.Cells(i, "B")
ComboBox1.AddItem s & Space(10 - Len(s)) & sh2.Cells(i, "C")
End If
Next i
End If
End Sub
および
Private Sub ComboBox1_Click()
tg.Offset(0, 1) = Left(ComboBox1.Text, 10)
tg.Offset(0, 2) = Mid(ComboBox1.Text, 10, 10)
ComboBox1.Clear
tg.Offset(1, 0).Activate
ComboBox1.Top = tg.Offset(0, 3).Top
End Sub
ーー
操作
Sheet1のA列で
例えば「すいか」と入れて、Enter。
コンボの▼をクリック。Sheet2のすいか該当分がでる。
どれか１つ選択。
入力した行の、B、C列にコンボで選択した行の、店と値段がセットされる。
直下行に行くから、商品名の入力繰り返し。
Sheet1の途中結果
りんご A店 100
バナナ F店 200
すいか E店 800
ーー
＞しているのでLookupなどの関数では無理ではと思っていますがマクロだと可能でしょうか？
まとはずれ。複数該当分は取れない。
ーー
キャンセルやDELETEなどをすると、上記では手当てがしてないのでエラーになる。イベント・プロシはそういう限界のあるものです。