Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


19664 / 76732 ←次へ | 前へ→

【62496】Re:コンボボックスについて
発言  kanabun  - 09/7/26(日) 9:06 -

引用なし
パスワード
   > 考え方だけ
にしたがって、コード部分を補完するとこんな風ですかね?
ま、いろいろ考え方はあると思いますので、あくまでも一例
ですが。。。

> 入力シートにコントロールツールボックスから 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

97 hits

【62487】コンボボックスについて あの 09/7/24(金) 22:30 質問
【62492】Re:コンボボックスについて その 09/7/25(土) 15:57 発言
【62493】Re:コンボボックスについて あの 09/7/25(土) 21:48 質問
【62494】Re:コンボボックスについて kanabun 09/7/25(土) 22:00 発言
【62496】Re:コンボボックスについて kanabun 09/7/26(日) 9:06 発言
【62503】Re:コンボボックスについて kanabun 09/7/27(月) 7:47 発言
【62521】Re:コンボボックスについて あの 09/7/28(火) 15:12 お礼

19664 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free