エクセルのマクロ

質問

ご指導願います。
VBAで以下の機能を作りたいと考えています。
　1.任意のセルをマウスで指す
　2.セル横に▼が表示され，”東京”と”大阪”が表示される
　3.どちらか選択した方がセルに格納される
　以上の機能を入力規則や，フォームツールボックスなどで，VABを使わずに作ることはできます。
　VBAで東京や大阪といった項目を設定し，任意のセル横に▼を表示したりする方法ご指導願いたいと存じます。よろしくお願い致します。

回答No.1

nishi6 · ベストアンサー

Sheet1で行う例です。

VBAのコントロールツールボックスからSheet1にコンボボックスを１つ作ります。
混乱をきたすとまずいので、オブジェクト名などは初期値のままとします。
（オブジェクト名は初期値のComboBox1とします）高さ、幅は適当に調整して下さい。

『東京、大阪』をどのように設定すればいいか明言されていないので、数も２つだし
コンボボックスを表示する時にセットしています。
ListFillRangeプロパティで事前に設定していれば、If～End Ifは不要になります。
例えば、セルA1=東京、A2=大阪にしてListFillRangeをA1:A2にするような感じです。
実質３行で終わっています。
Sheet1全体で入力ができるのもおかしいので、Ｂ列のみこの操作ができるようにしてあります。
テキトーに修正して下さい。

ツール→マクロ→Visual Basic Editor でVBE画面に移り、Sheet1のコードウインドウに貼り付けます。

ここから
↓
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
　　With ComboBox1
　　　　If Target.Column = 2 Then　　　'Ｂ列(Column=2)なら表示する例
　　　　　　.Visible = True
　　　　　　If .ListCount <> 2 Then　　'クリックの都度Listを決めている
　　　　　　　　.Clear
　　　　　　　　.AddItem "東京"
　　　　　　　　.AddItem "大阪"
　　　　　　End If
　　　　　　.Top = Target.Offset(0, 1).Top　　　'縦位置を決める
　　　　　　.Left = Target.Offset(0, 1).Left　　'横位置を決める
　　　　　　.LinkedCell = Target.Address　　　　'リンクするセルを決める
　　　　Else
　　　　　　.Visible = False
　　　　End If
　　End With
End Sub

お礼

うまくできました。
ありがとうございました。

回答No.3

imogasi

「セルに内容をセットしたい」との希望がよせられたので、上の2つのドロップダウンのクリックした項目内容をセルにセットする方法を載せます。
－－－－－－－
１番上のドロップダウンの所へカーソルを置いて、マウスの右クリック
を押す。「マクロ登録」をクリック。「新規作成」をクリック。
Sub ドロップ１_Change()

End Subと現れるから、ＳｕｂとＥｎｄＳｕｂの間に下記を貼りつける。
「実行」し、ワークシートに帰り、ドロップダウンの▼をクリックして
好きな項目を選択すると、セルに、ドロップダウンで選んだ項目が出る。
－－－－－－－
Sub ドロップ1_Change()
ary1 = Array("", "東京", "大阪", "名古屋", "仙台")
a = ActiveSheet.DropDowns(1).ListIndex
Worksheets("sheet1").Range("a4") = ary1(a)
End Sub
Sub ドロップ2_Change()
ary1 = Array("", "夏", "秋", "冬", "春")
a = ActiveSheet.DropDowns(2).ListIndex
Worksheets("sheet1").Range("a6") = ary1(a)
End Sub
－－－－－－
ＬｉｎｋｅｄＣｅｌｌの場合はＬｉｓｔＩｎｄｅｘの数字しか現われないが、このような似た設定で項目内容が出せる設定があったように思いますが、思い出せないので取りあえず上記のようにして見ました。ＬｉｓｔやＬｉｓｔＩｎｄｅｘ辺りを調べればわかるかも。

お礼

たびたびのご指導ありがとうございました。
たいへん勉強になりました。

回答No.2

imogasi

下記の様なのはいかがですか。
ＡｄｄＩｔｅｍのところを簡略にしたかったんですが取りあえず載せます。
Sub test01()
Dim n(10)
ll = Worksheets("sheet1").Cells(3, 3).Left
tt = Worksheets("sheet1").Cells(3, 3).Top
ww = Worksheets("sheet1").Cells(3, 3).Width
hh = Worksheets("sheet1").Cells(3, 3).Height
k = 1
For i = 1 To 10 Step 2
With Worksheets("sheet1")
Set cb = .Shapes.AddFormControl(xlDropDown, ll, tt + hh * i, ww, hh)
n(k) = cb.Name
' cb.ControlFormat.LinkedCell = "A" & Trim(Str(2 + 2 * k))
k = k + 1
End With
Next i
Worksheets("sheet1").DropDowns(n(1)).AddItem ("東京")
Worksheets("sheet1").DropDowns(n(1)).AddItem ("大阪")
Worksheets("sheet1").DropDowns(n(1)).AddItem ("名古屋")
Worksheets("sheet1").DropDowns(n(1)).AddItem ("福岡")
'---------
Worksheets("sheet1").DropDowns(n(2)).AddItem ("夏")
Worksheets("sheet1").DropDowns(n(2)).AddItem ("秋")
Worksheets("sheet1").DropDowns(n(2)).AddItem ("冬")
Worksheets("sheet1").DropDowns(n(2)).AddItem ("春")
'---------
Worksheets("sheet1").DropDowns(n(3)).AddItem ("男")
Worksheets("sheet1").DropDowns(n(3)).AddItem ("女")
Worksheets("sheet1").DropDowns(n(3)).AddItem ("子供")
Worksheets("sheet1").DropDowns(n(3)).AddItem ("老人")
'---------
Worksheets("sheet1").DropDowns(n(4)).AddItem ("１０代")
Worksheets("sheet1").DropDowns(n(4)).AddItem ("２０代")
Worksheets("sheet1").DropDowns(n(4)).AddItem ("３０代")
Worksheets("sheet1").DropDowns(n(4)).AddItem ("４０代")
'---------
Worksheets("sheet1").DropDowns(n(5)).AddItem ("大卒")
Worksheets("sheet1").DropDowns(n(5)).AddItem ("高卒")
Worksheets("sheet1").DropDowns(n(5)).AddItem ("短大卒")
Worksheets("sheet1").DropDowns(n(5)).AddItem ("院卒")
End Sub

お礼

ご指導ありがとうございます。
DropDownの入力結果をセルに入力することはできるのでしょうか。