プロが教える店舗&オフィスのセキュリティ対策術

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行目の該当セル(記入必須項目)の空欄が無いこと・入力が正しいかをチェックする様な条件分岐のマクロ記述方法を教えてください。
説明が拙いかと存じますが、宜しくお願いします。

A 回答 (2件)

こんにちは。


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

名前: 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()に設定します。


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

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
    • good
    • 0

これはプチ課題の丸投げですね。


(1)質問の文章は長いが、入力シート(Sheet1と仮定して)に数件入力した時の後の姿が書かれていないので判りにくい。このほうが自然だろうと推定でやった。
(2)リストボックスはコンボでやった。
クリックする前は、大きさが1行で済むのでこの方が良かろうかと思った。(オブジェクトをリストボックスを貼り付けにして、下記コードでCombox1をlistBox1に置き換えると動くと思う。)
ーー
全般に簡単そうに見えるが、質問者のレベルでは、荷が重いのでは。
色々な課題が諸所に散らばっていると思うが、相当時間をかけないと
(まねすれば早いが)独力では、使えないもののようにおもう。
ーー
例データ
Sheet2 A2:C10
りんごA店100
りんごB店90
すいかA店950
すいかC店800
みかんD店100
すいかE店800
バナナF店200
すいかG店750
みかんG店200
Sheet1
コンボボックスを1つ張り付け。高さは1セル分。幅は2列データが
出せるぐらい。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のすいか該当分がでる。
どれか1つ選択。
入力した行の、B、C列にコンボで選択した行の、店と値段がセットされる。
直下行に行くから、商品名の入力繰り返し。
Sheet1の途中結果
りんごA店 100
バナナF店 200
すいかE店 800
ーー
>しているのでLookupなどの関数では無理ではと思っていますがマクロだと可能でしょうか?
まとはずれ。複数該当分は取れない。
ーー
キャンセルやDELETEなどをすると、上記では手当てがしてないのでエラーになる。イベント・プロシはそういう限界のあるものです。
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています