[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『リスト以外の選択方法について』（なお）
いつも掲示板を参考にさせていただいています。
リスト以外の選択方法を教えてください。
現在A1に商品の選択リストを作って商品選択をしていましたが、30品目以上になると毎回の選択が大変になります。
そこで選択用のシートを作成しチェックボタンのようなものを押すとA1に反映するようなものを作成しようとしましたがうまくできませんでした。どのような方法があるのか教えていただければ幸いです。ちなみにイメージは下の通りです。
Sheet1
A 1 りんご
Sheet2
A B
1 ● りんご
2 ○ みかん
3 ○ なし
＜ 使用 Excel：Excel2010、使用 OS：WindowsXP ＞
案 グループ化する __A________B___ 1|果物___|野菜__ 2|りんご_|めろん 3|みかん_|すいか 4|なし___|いちご
1行目を選択すると、そのグループに属するものだけ選択できるようになる グループは「あかさたな」順でもよい
（稲葉） 2014/12/08(月) 17:48
一気に難易度上がりますけど、ユーザーフォームのリストボックスを利用されてはどうですか？
またはデータ量が1万とか行かないようであれば、シートのチェンジイベントを拾って、 リストそのものをフィルタしたデータに書き換えるとか。
確認ですけど、今回の質問は「どのような方法があるか」であって、「コードを書いてほしい」では ないんですよね？ （稲葉） 2014/12/08(月) 18:46
（なお） 2014/12/08(月) 18:56
>〜〜コードも含め教えていただきたいと思います。 とすれば情報が少なすぎます。
１）30項目あるものにラジオボタンは現実的ではないので、リストボックスを使用 すると効率が良くなると考えます。 その方向でよろしいですか？
２）リストの範囲はどうなっていますか？ 選択させるブックに対して、リストがあるブック名、シート名、セル範囲
３）選択させるセルはA1だけですか？ それともA列全部、または飛び石になっていたりしますか？
４）フィルタをかける場合、どのようにしたいのか、２）の質問と合わせて教えてください。 できれば表で！ エクセルのセルをコピーしてそのまま貼り付けてもらってもかまいません。
※今日ちょっと忙しいのですぐ対応できないと思いますが・・・ （稲葉） 2014/12/09(火) 08:33
＞選択品目は150〜200くらいです。 と言う事ですが ＞選択用のシートを作成しチェックボタンのようなものを押すとA1に反映するようなものを作成しようとしました この案では、 Sheet2に150〜200の品目をすべて並べておいてその中から選ぶ と言う事でしょうか？
考え方として リストから選ぶと、最悪200行目までスクロールが必要だが マトリックス状に並べておけば見つけやすい。 と言う事であれば、 ダブルクリックしたら、Sheet2のそのセルの値が、Sheet1のA1セルに入る ボタンを押したら、Sheet2のアクティブセルの値がSheet1のA1セルに入る とかでも良さそうに思いますが。
いずれにしても、マクロの使用になります。
Sheet1へ入力するセルがA1以外もあるのなら もう少し考えないといけなくなると思いますが。 （HANA） 2014/12/09(火) 11:14
【標準モジュール】
Public pw As String
【シートモジュール】
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
UserForm1.Show
Target.Value = pw
Cancel = True
End Sub
【フォームモジュール】
Private Sub CommandButton1_Click()
Dim opt As Control
pw = ""
For Each opt In Controls
If opt.Value = True Then
pw = opt.Caption
Exit For
End If
Next
Unload Me
End Sub
使い方は、シート上で右クリックするとフォームを表示。商品を選択しボタンを押すと、商品名がセルに転記されます。
（複数セル選択してから右クリックも可能）
（???） 2014/12/09(火) 11:59
前に作ったものでなんかできないか考えてみました。
Sheet2に以下のような表（選択させるもの）を作る。 1行目は項目名 2行目から選択させたいもの [A] [B] [C] [1] 果物 野菜 [2] みかん いちご [3] りんご めろん [4] ばなな すいか [5]
◆VBAProjectを右クリック→クラスモジュールの追加
クラスモジュールの名前をClass1からclsPopupに変更
ダブルクリックで開き、中のコードに以下を貼り付ける
Option Explicit
'clsPopup
Private Popup As Object
Private 子 As Collection
Private Sub Class_Initialize()
Set Popup = CommandBars.Add(Position:=msoBarPopup)
Set 子 = New Collection
End Sub
Private Sub Class_Terminate()
'//別れの朝回避
Popup.Delete
End Sub
Public Sub Rgst()
Popup.ShowPopup
End Sub
Public Sub AddItem(ByVal Title As String, ByVal 子ID As String, ByVal Args As Variant, Optional ByVal Action As String = "InputValue", Optional ByVal faceID As Long = 0)
Dim tmpPop As Object
Dim Arg
Dim tmp As Variant
'//Argsが配列で渡される（複数の引数）か、単数か
If IsArray(Args) Then
For Each tmp In Args
Arg = Arg & IIf(Arg = "", "", ",") & Chr(34) & tmp & Chr(34)
Next tmp
Else
Arg = Chr(34) & Args & Chr(34)
End If
Action = "'" & Action & " " & Arg & " '"
'//エラー処理
If faceID = 0 Then faceID = 483
If 子ID = "0" Then
Set tmpPop = Popup
Else
Set tmpPop = 子(子ID)
If Err > 0 Then MsgBox "存在しないIDです": Exit Sub
End If
'//コントロールの追加
With tmpPop
With .Controls.Add
.Caption = Title
.OnAction = Action
.faceID = faceID
End With
End With
End Sub
Public Sub AddPop(ByVal Title As String, ByVal 子ID As String, Optional ByVal Nest As String = "")
Dim tmpPop As Object
If Nest = "" Then
Set tmpPop = Popup
Else
On Error Resume Next
Set tmpPop = 子(Nest)
If Err > 1 Then MsgBox "ネストさせる子IDがありません": Exit Sub
On Error GoTo 0
End If
With tmpPop
On Error Resume Next
子.Add .Controls.Add(Type:=msoControlPopup), CStr(子ID)
If Err > 1 Then MsgBox "既に子IDが追加されています。": Exit Sub
On Error GoTo 0
子(子ID).Caption = Title
End With
End Sub
◆次に標準モジュールに以下を貼り付ける
Option Explicit
Public Pmenu As clsPopup
Sub GetList()
Set Pmenu = New clsPopup
Dim tbl
Dim r As Long, c As Long
Dim x
tbl = Sheets("Sheet2").Range("A1").CurrentRegion.Value
With Pmenu
For c = 1 To UBound(tbl, 2)
For r = 1 To UBound(tbl, 1)
x = tbl(r, c)
If x = "" Then Exit For
Select Case r
Case 1
.AddPop x, c
Case Is > 1
.AddItem x, c, x
End Select
Next r
Next c
End With
End Sub
Sub InputValue(ByVal GetData)
Selection.Value = GetData
End Sub
◆最後に選択させたいシートモジュールに以下を貼り付ける
Option Explicit
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target.CountLarge <> 1 Then Exit Sub
If Not Target.Address Like "$A$*" Then Exit Sub
Pmenu.Rgst
Cancel = True
End Sub
◆実行の手順 1.GetListを実行する 2.選択させたいセルを右クリック 3.ポップアップから選択する でいかがでしょうか？
（稲葉） 2014/12/10(水) 17:57
少々お返事が遅くなりまして申し訳ございません。
VBAの使用方法に戸惑いつつも過去ログを見ながら試してみます。
とりあえず金曜日まで作成してみます。
（なお） 2014/12/10(水) 23:10
VBAの知識を必要としなくてもわかりやすくご説明いただきありがとうございました。
まさにほしかった内容のものです。
拙い質問で完璧な回答ありがとうございました。
（なお） 2014/12/10(水) 23:36
先日は選択シートについてご教授ありがとうございました。
思い通りのシートが出来上がってきました。が一つ追加の質問があります。
選択画面で出るクローバーを数字や他の形にするにはどのようにすればよいのでしょうか？また選択の際商品名に色を付けることもできるのでしょうか？
（なお） 2014/12/12(金) 19:15
返事が遅くなりました。
＞また選択の際商品名に色を付けることもできるのでしょうか？ これはセルに？ ポップアップに？ 後者ならできないと思われます。（後述） 前者に関しては条件付き書式でいかがですか？
【前書き】 ＞選択画面で出るクローバーを数字や他の形にする これはエクセル標準の「FaceID」からしか選べません。 Popupそのものをユーザーフォームで作っているのではなく、標準機能から呼び出して 使っているためです。 http://www.ne.jp/asahi/fuji/lake/excel/faceid_02.html
「値」に当たる部分は今はスペードになっていると思います。
AddItemメソッドの引数は
AddItem(Title , 子ID , Args , Action , FaceID)になっています
~~~~~ ~~~~ ~~~~ ~~~~~~~~~~~~~~~
x c x 省略
「項目名」に当たる部分にFaceIDは入れられなかったと思いますので、 Titleに(1)など、工夫すればよいと思います。
【結論】 具体的に変更していただきたいところは、 ＞.AddItem x, c, x ここの部分を .AddItem Title:=x, 子ID:=c, Args:=x, FaceID:=先ほど紹介したURLのお好きなＩＤ
このように変更してください。
（稲葉） 2014/12/15(月) 09:11
Option Explicit
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target.CountLarge <> 1 Then Exit Sub
If Not Target.Address Like "$A$*" Then Exit Sub
Pmenu.Rgst
Cancel = True
End Sub
（なお） 2014/12/19(金) 20:02
可能です。 ちなみにどこを直せばいいと思いますか？ （稲葉） 2014/12/22(月) 10:57
質問させていただきましたが返答が大変遅くなりすみませんでした。身内に不幸があったものでまったくパソコンをいじれませんでした。
A2とA3のみポップアップさせるのに
If Not Target.Address Like "$A2:A3$*" Then Exit Sub
としましたが駄目でした。もしやと思い
If Target.CountLarge <A2:A3> 1 Then Exit Sub
としましたがまた駄目でした。勉強不足です。どうか教えてください。
（なお） 2015/01/14(水) 17:29
お悔やみ申し上げます。 年末年始に大変でしたね。
＞ If Not Target.Address Like "$A2:A3$*" Then Exit Sub 惜しいです。 AddressプロパティとLike演算子を後で調べてみてください。
今回は2つのセルだけが対象ですので ＞If Not Target.Address Like "$A$*" Then Exit Sub これを 以下に置き換えてみてください
Select Case Target.Address(1, 1)
Case "A1", "A2"
Pmenu.Rgst
Cancel = True
End Select
もっと複数の範囲を指定したい等要望が出てきたら、Intersectメソッド等 いくつか手段がありますので、興味があれば調べてみてください。
（稲葉） 2015/01/14(水) 17:43
今回教えていただいた内容で直してみましたところ、すべてのセルでポップアップの選択ができるようになってしましました。
Select Case Target.Address(1, 1)
Case "A1", "A2"
Pmenu.Rgst
Cancel = True
End Select
のCase "A1", "A2"を変更しましたが駄目でした。
重ねご教授願います。
（なお） 2015/01/14(水) 20:31
もしかして Target.Address(1, 1)→Target(1, 1).Address Case "A1", "A2"→Case "$A$1", "$A$2" か？
（ねむねむ） 2015/01/15(木) 09:13
ねむねむさんフォローありがとうございます！ そこも間違ってました！すみません。
たぶん、一行だけ置き換えて、
Pmenu.Rgst
を消さなかったから「全部のセル」になってしまったのだと思います。
最初から全部掲載すればよかったですね。 お手数おかけしました。
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Target.CountLarge <> 1 Then Exit Sub
Select Case Target.Address(0, 0)
Case "A1", "A2"
Pmenu.Rgst
Cancel = True
End Select
End Sub
（稲葉） 2015/01/15(木) 09:16
時間をかけてじっくりやりましたので満足です。
これからもっと勉強します。
（なお） 2015/01/15(木) 19:21
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.