Excel:既入力項目をドロップダウンリストに（入力規則？）

Excelで、
ある列に簡単な文字列を入力していっているのですが、
それまでに同じ列で入力したのと同じ内容を入力する際に、
ドロップダウンリストを使いたいと思っております。
入力リストとも思うのですが、内容が固定でなく、
新たな内容を入力したら、それもリストで
使えるようにしたいです。

（例）
AAA
（空白）
（空白）
BBB
（空白）
CCC
（空白）
　　　　←ここを入力するときに、
　　　　　AAA・BBB・CCCから選択またはDDDを手入力
　　　　←上でDDDを入力していたらAAA・BBB・CCC・DDDから選択
　　　　　そうでなければAAA・BBB・CCCから選択
以下ずっとこんな感じ（新項目を入力したら以後それもリストに入ってほしい）

このような場合、どのように設定したらよいのか、
お分かりの方がいらっしゃいましたらご回答ください。

No.6 ベストアンサー 回答者： Wendy02 回答日時： 2009/10/19 15:26

こんにちは。

>自動的にリスト形式になってしまい、新たな（＝リストにない）項目入力ができなくなってしまいます。

これは、私のミスです。すみません。それと、細かい点も見直してみました。また、ダブルクリックではなく、右クリックや、Alt + ↑に置き換えることも可能です。

以下のようにすれば、リストにないものでも加えられるようになります。入力規則のドロップダウンが邪魔になるときに、消すプログラムも付けておきます。シートをアクティブにすると消えます。

それと、今は、文字のリストを使っていますので、たぶん、そんなに多く入らないかもしれません。もし、そういう状況になったら、シートのどこかにリストを作ってあげれば、1000個ぐらいは可能になると思います。ただ、1000個もあったら、探すのが面倒だと思いますが。


'-------------------------------------------

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim tRng As Range
　　Cancel = True
　　ActiveCell.EntireColumn.Validation.Delete
　　If WorksheetFunction.CountA(Target.EntireColumn) = 0 Then Exit Sub
　　Set tRng = Range(Cells(1, Target.Column), Cells(Rows.Count, Target.Column).End(xlUp))
　　With Target.Validation
　　　　.Delete
　　　　.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
　　　　 Operator:=xlBetween, Formula1:=UniqLists(tRng)
　　　　.IgnoreBlank = True
　　　　.InCellDropdown = True
　　　　.ShowError = False
　　End With
End Sub

Function UniqLists(rng As Range) As String
'リスト化する関数プロシージャ
　　Dim i As Long
　　Dim ret As Variant
　　Dim buf As String
　　With rng.Columns(1)
　　　　For i = 1 To .Rows.Count
　　　　　　If .Cells(i, 1).Value <> "" Then
　　　　　　　　ret = Application.Match(.Cells(i, 1).Value, .Cells, 0)
　　　　　　　　If IsNumeric(ret) And ret = i Then
　　　　　　　　　　buf = buf & "," & .Cells(i, 1).Value
　　　　　　　　End If
　　　　　　End If
　　　　Next i
　　End With
　　UniqLists = Mid(buf, 2)
End Function

'-------------------------------------------
Private Sub Worksheet_Activate()
'シートをアクティブしたときに、入力規則のリストを削除する
Dim rng As Range
　On Error Resume Next
　Set rng = ActiveSheet.Cells.SpecialCells(xlCellTypeAllValidation)
　rng.Validation.Delete
　Set rng = Nothing
　On Error GoTo 0
End Sub

この回答へのお礼

希望の動作を確認いたしました。

前回のものですと何も入力していない列をダブルクリックすると
エラーになってしまっていたのですが、
指摘していないのにしっかりと修正されていた！のも
大変感心いたしました。

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

お礼日時：2009/10/19 17:30

No.5 回答者： imogasi 回答日時： 2009/10/19 12:45

２つのことと関連していて、難しい点は、

（１）入力規則
　　途中空白がある
　　項目（入力規則の元のデータ）が増えていく
（２）オートフィルタ
　　ALT+↓
既に入力した文字列に限るなら（２）が相応しいが、途中行で空白セルがあるとそれより上は出してくれない。
ーーー
例データ　A列は入力列。B列は作業列
A列　　　B列
連番
aaa1

aaa
sss2


sss

xxx3
xxx

xxx

ssss4

ssss
xcvvv5
xcvvv

B2の式
=IF(AND(A2<>"",COUNTIF($A$2:A2,A2)=1),MAX($B$1:B1)+1,"")
一応の縛りとして、第１００行まで入力するとする。
第１００行まで式を複写。
ーーー
H列は作業列。
H2は=IF(ROW()-1>MAX($B$1:$B100),"",INDEX($A$1:$A$1:$A$100,MATCH(ROW()-1,$B$1:$B$100,0)))
を第１００行まで式複写。
結果
aaa
sss
xxx
ssss
xcvvv
ーーー
入力規則の設定操作
A列A2:A100を範囲指定して
データ
入力規則
リスト
元の値に式で
=OFFSET($H$2,0,0,MAX($B$2:$B$100),1)
ーーー
これで質問要求に近いものだろう。
上記は「imogasi方式」（興味あればGoogleで照会のこと）の応用です。

この回答へのお礼

ありがとうございます。

おっしゃる方法でうまくいきました！
（新たな項目を入力できなかったので
入力規則でエラーメッセージを出す
というチェックは外しましたが）

No.4さんように、マクロ？を使うか、
作業行（セルのコピーあり）を使うかってことで、
他の作業条件を見ながら選択していきたいと思います。

お礼日時：2009/10/19 14:18

No.4 回答者： Wendy02 回答日時： 2009/10/19 12:40

こんにちは。

ご質問者さんのおっしゃっているドロップダウンリストは、右クリックメニューに出てくるドロップダウンリストだと思いますが、#3さんのおっしゃるリストは、間に空白があると出てこないはずです。

そこで、マクロで代用品を作ってみました。シート・タブを右クリックして、コードの表示で、以下を貼り付けてください。入力規則のドロップダウンリストは、いつも一個しか存在しません。

以下は、ダブルクリックして、ドロップダウンリストを表示します。

'-------------------------------------------

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'ダブルクリック・イベント
Dim tRng As Range
　　Cancel = True
　　Columns(Target.Column).Validation.Delete
　　Set tRng = Range(Cells(1, Target.Column), Cells(Rows.Count, Target.Column).End(xlUp))
　　With Target.Validation
　　　　.Delete
　　　　.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
　　　　 Operator:=xlBetween, Formula1:=UniqLists(tRng)
　　　　.IgnoreBlank = True
　　　　.InCellDropdown = True
　　End With
End Sub

Function UniqLists(rng As Range) As String
　　Dim i As Long
　　Dim ret As Variant
　　Dim buf As String
　　With rng.Columns(1)
　　　　For i = 1 To .Rows.Count
　　　　　　If .Cells(i, 1).Value <> "" Then
　　　　　　　　ret = Application.Match(.Cells(i, 1).Value, .Cells, 0)
　　　　　　　　If IsNumeric(ret) And ret = i Then
　　　　　　　　　　buf = buf & "," & .Cells(i, 1).Value
　　　　　　　　End If
　　　　　　End If
　　　　Next i
　　End With
　　UniqLists = Mid(buf, 2)
End Function
　　
　　

この回答へのお礼

ありがとうございます。

基本的なことは、うまく行きました！
すばらしいです。

ただ、すいませんが、一点だけリクエストがあります。
もしお分かりなら教えてください。

それは、一度ダブルクリックしたセルに対して、何も入力せず一度フォーカス（選択）を外したあと、
再度そのセルに移動すると（その移動がマウスのクリックでもキーボードの矢印キーでも）
自動的にリスト形式になってしまい、新たな（＝リストにない）項目入力ができなくなってしまいます。

一度もダブルクリックしなければ、新たな項目を入力できるのですが。
一度ダブルクリックしたセルもこの初期状態に自動的に戻すなんてことはできませんでしょうか。

お礼日時：2009/10/19 13:51

No.3 回答者： A88No8 回答日時： 2009/10/19 11:42

こんにちは

　入力規則にそのような高度な機能はありませんが Excel2003の場合、入力済セルに接しているセルをクリックなどして入力状態にした後に[Alt]+[↓]キーを押すと上に入力したデータが入力順に整理されて選択できるようになっています。

　質問者さんのExcelではできませんか？

この回答へのお礼

ありがとうございます。

試した見たところ、Alt＋↓は
空白セルが間にあるとうまく行かないみたいです。
（Excel2003）
質問の（例）のような状態になっておりますので。。。

残念です。

お礼日時：2009/10/19 12:02

No.2 回答者： kybo 回答日時： 2009/10/19 11:41

例えば、元のデータの入力している範囲が、A2:A10だとすると、

データ→入力規則→リストの元の値で

=$A2:$A65536

のように変更してOKすればいいと思われます。（入力されている最終行以降の空白データは表示されません）

あえて、最終行までと指定したい場合は、

=INDIRECT("A2:A"&MATCH(10^100,A:A,1))

のような数式をいれればいいです。

この回答へのお礼

ありがとうございます。

> 元のデータの入力している範囲が、A2:A10だとすると、
というのはどのような意味でしょうか。
元のデータ自体が入力に従って増えて行くのですが。。。

いちおう、=$A2:$A65536
の方でやってみましたが、
ドロップダウンリストが
空白になってしまいました。

お礼日時：2009/10/19 12:00

No.1 回答者： akiomyau 回答日時： 2009/10/19 11:34

残念ながらそういった自動的にリストが追加されるような設定はありません。

この回答へのお礼

ありがとうございます。
そうですかー。残念です。

お礼日時：2009/10/19 11:57