| |
> 考え方だけ
にしたがって、コード部分を補完するとこんな風ですかね？
ま、いろいろ考え方はあると思いますので、あくまでも一例
ですが。。。
> 入力シートにコントロールツールボックスから ComboBoxをひとつ
> シートに貼り付けておき､
→ これは手作業でさいしょにやっておいてください。
> ThisWorkbookの Workbook_Open() プロシージャにて
> シート2のリスト項目をComboBoxに セットしておく｡
'--------------------------------------- ThisWorkbook モジュール
Option Explicit
Private Sub Workbook_Open()
Dim myList
With Worksheets(2) '「リスト」シート
myList = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)).Value
End With
With Worksheets(1).ComboBox1 '入力シート
.List = myList
.BackColor = &HC0FFFF
.Visible = False
End With
End Sub
'--------------------------------------- 入力シート モジュール
' (ComboBox1を置いたシート)
Option Explicit
Private NoChange As Boolean 'モジュールレベル変数
> 入力シートの_SelectionChangeイベントに
> 移動先の列番号が A列だったら､セルの右にComboBoxを
> 表示させる｡
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With ComboBox1
If Target.Count > 1 Then .Visible = False: Exit Sub
If Not (Intersect(Columns(1), Target) Is Nothing) Then
.Left = Target.Item(1, 2).Left
.Top = Target.Top
Dim v, m
v = Target.Value
If Not IsEmpty(v) Then 'すでにセルに入力値があるとき
m = Application.Match(v, .List, 0) 'リスト内を検索して
If IsNumeric(m) Then '一致するアイテムが
NoChange = True 'あれば、
.Text = .List(m - 1) 'そのアイテムを選択
NoChange = False
End If
End If
.Visible = True
Else
.Visible = False
End If
End With
End Sub
> ComboBoxでクリックイベントがあったら､選択セルに選択
> アイテムを代入｡
Private Sub ComboBox1_Change()
If NoChange Then Exit Sub
Application.EnableEvents = False
ActiveCell.Value = ComboBox1.Value
ActiveCell.Offset(1).Select
Application.EnableEvents = True
End Sub
> すると､シートの_Changeイベントが起きるので､
> そこで入力値がリストのものであるかチェックする｡
> 入力値がリストのどれとも一致しない場合は
> メッセージを出して､値をシート2のリストに追加する｡
Private Sub Worksheet_Change(ByVal Target As Range)
Dim v, m
If Target.Count > 1 Then Exit Sub
If Target.Column > 1 Then Exit Sub
v = Target.Value
If IsEmpty(v) Then Exit Sub
m = Application.Match(v, ComboBox1.List, 0)
If IsError(m) Then
If MsgBox("入力された値はリストにありません。" & vbCr _
& " リストに追加しますか？", vbOKCancel) = vbOK Then
AddToList v
Else
Target.ClearContents
End If
End If
End Sub
''リストのあるシートに 値v を追加し、
''入力シート(Me) のComboBox1のリストを更新する
Private Sub AddToList(v)
Dim c As Range
Dim myList
With Worksheets(2)
Set c = .Range("A65536").End(xlUp).Offset(1)
c.Value = v
Set c = .Range("A2", c)
c.Sort Key1:=c, Header:=xlNo
myList = c.Value
End With
Me.ComboBox1.List = myList
End Sub
|
|
kanabun
- 09/7/26(日) 9:06 -
