入力条件付きドロップダウンリスト
セルA１からA5に入力する方法はドロップダウンリストで
そのリストデータは、セルC１～C6の値
（リストの内容：サンプル1,サンプル2,サンプル23,サンプル4,サンプル5,サンプル6,）
とします。
そこで、例えば
(1)セルA１にて”サンプル1”をドロップダウンリストで選択します。
(2)セルA２においてのドロップダウンリストの内容は、
既にセルＡ1で選択された”サンプル1”を除く、（サンプル2,サンプル23,サンプル4,サンプル5,サンプル6）
とし
(3)セルA3においてのドロップダウンリストの内容は、セルA１、セルA2で選択されたものを除く
(4)セルA4においてのドロップダウンリストの内容は、セルA１、セルA2、セルA3で選択されたものを除く
(5)セルA5においてのドロップダウンリストの内容は、セルA１、セルA2、セルA3、セルA4で選択されたものを除く
と言ったようなことをエクセルマクロでできるでしょうか？
マクロ初心者な為、ご教授宜しくお願い申し上げます。
また入力する順番は、以下のの２通りを考えております。
（１） A１→A2→A3→A4→A5
（２） ランダム
No.1
3454
969
27pt
VBAでWorkSheet_Changeイベントでリストを設定するようにすればいいです。
具体的には、下記のコードをシートモジュールにコピペ
（シートモジュールはシートのタブを右クリックしてコードの表示で表示される画面です。）
Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("A1:A5")) Is Nothing Then Exit Sub Dim i As Integer Dim j As Integer Dim s As String Dim f As Boolean For i = 1 To 6 f = False For j = 1 To 5 If Cells(i, "C").Value = Cells(j, "A").Value Then f = True Exit For End If Next j If Not f Then s = s & "," & Cells(i, "C").Value End If Next i For i = 1 To 5 Cells(i, "A").Validation.Delete Next i If s = "" Then s = " " For i = 1 To 5 With Cells(i, "A").Validation .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:=s .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .IMEMode = xlIMEModeNoControl .ShowInput = True .ShowError = True End With Next i End Sub
次にC1～C6にサンプル１～サンプル６と書き込み、
そのままでは最初リストは設定されていないのでA1セルに適当な文字を入力すると
A1～A5にリストが自動的に設定されます。
No.1
3454969
ここでベストアンサー
27pt
VBAでWorkSheet_Changeイベントでリストを設定するようにすればいいです。
具体的には、下記のコードをシートモジュールにコピペ
（シートモジュールはシートのタブを右クリックしてコードの表示で表示される画面です。）
Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("A1:A5")) Is Nothing Then Exit Sub Dim i As Integer Dim j As Integer Dim s As String Dim f As Boolean For i = 1 To 6 f = False For j = 1 To 5 If Cells(i, "C").Value = Cells(j, "A").Value Then f = True Exit For End If Next j If Not f Then s = s & "," & Cells(i, "C").Value End If Next i For i = 1 To 5 Cells(i, "A").Validation.Delete Next i If s = "" Then s = " " For i = 1 To 5 With Cells(i, "A").Validation .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:=s .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .IMEMode = xlIMEModeNoControl .ShowInput = True .ShowError = True End With Next i End Sub
次にC1～C6にサンプル１～サンプル６と書き込み、
そのままでは最初リストは設定されていないのでA1セルに適当な文字を入力すると
A1～A5にリストが自動的に設定されます。
SALINGER様
お世話になっております。マクロのコードありがとうございます。
セルA1～A5とC１～C6以外のセルに「メニュー」-「ツール」－「保護」で
ロックをかけた後、実行した場合
実行時エラー 2147417848（80010108）
Addメソッドは失敗しました。Validationオブジェクトと
が発生してしまうのですが、回避方法等はありますでしょうか？
有りましたらご教授して戴きたくよろしくお願い申し上げます。
No.2
2915301
27pt
（１）ＶＢＡの例
9
5
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 And Target.Row >= 1 And Target.Row <= 5 Then
Dim pickupList As String
For Each c In Range("C1:C6")
If c.Value <> "" Then
If Range("A1:A5").Find(c.Value) Is Nothing Then
pickupList = pickupList & "," & c.Value
End If
End If
Next
pickupList = Mid(pickupList, 2)
With Range("A1:A5").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=pickupList
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.IMEMode = xlIMEModeNoControl
.ShowInput = True
.ShowError = True
End With
End If
End Sub
※このコードは標準モジュールではなく、シートのモジュールに貼り付けて使ってください。
（２）ＶＢＡを使わない例 基本型
| A | B | C | D | |
|---|---|---|---|---|
| 1 | サンプル１ | =IF(COUNTIF($A$1:$A$6,C1)=0,C1,"") | ||
| 2 | サンプル２ | ↓下方向コピー | ||
| 3 | サンプル３ | ↓下方向コピー | ||
| 4 | サンプル４ | ↓下方向コピー | ||
| 5 | サンプル５ | ↓下方向コピー | ||
| 6 | サンプル６ | ↓下方向コピー |
上記を入力したら「A1からA5までを選択」して「データ→入力規則 → 設定」と進み、
入力値の種類は「リスト」元の値に「=$D$1:$D$6」を入力してＯＫ。
これで設定完了。
（３）ＶＢＡを使わない例 応用
| A | B | C | D | E | |
|---|---|---|---|---|---|
| 1 | サンプル１ | =IF(COUNTIF($A$1:$A$6,C1)=0,C1,"") | =ROWS($D$1:$D$6)-COUNTBLANK($D$1:$D$6) | ||
| 2 | サンプル２ | ↓下方向コピー | =VLOOKUP("*?",$D$1:$D$6,1,) | ||
| 3 | サンプル３ | ↓下方向コピー | =VLOOKUP("*?",INDEX($D$1:$D$6,MATCH(E2,$D$1:$D$6,)+1):$D$6,1,) | ||
| 4 | サンプル４ | ↓下方向コピー | ↓下方向コピー | ||
| 5 | サンプル５ | ↓下方向コピー | ↓下方向コピー | ||
| 6 | サンプル６ | ↓下方向コピー | ↓下方向コピー | ||
| 7 | ↓下方向コピー |
上記を入力したら「A1からA5までを選択」して「データ→入力規則 → 設定」と進み、
入力値の種類は「リスト」元の値に「=OFFSET($E$2,,,$E$1,)」を入力してＯＫ。
これで設定完了。Ｄ列Ｅ列は動作確認ができたら非表示にしておくと良いでしょう。
※Ｅ列のみ１行目にて表示行数を計算しているので下方向に一段ズレます。
kn1967様
お世話になっております。
マクロのコードとマクロ以外の方法ありがとうございます。
マクロのほうで、
お世話になっております。マクロのコードありがとうございます。
セルA1～A5とC１～C6以外のセルに「メニュー」-「ツール」－「保護」で
ロックをかけた後、実行した場合
実行時エラー 2147417848（80010108）
Addメソッドは失敗しました。Validationオブジェクトと
が発生してしまうのですが、回避方法等はありますでしょうか？
可能ならば、入力するセル以外はロックをかけ保護したいと思っております。
有りましたらご教授して戴きたくよろしくお願い申し上げます。
マクロ以外の方の動作はこれから試してみます。
No.3
2915301
26pt
一時的にプロテクトの解除をします。
パスワードがaiueoだとすると
下記の箇所にUnprotectとProtectを入れます。
ActiveSheet.Unprotect Password:="aiueo" .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=pickupList ActiveSheet.Protect
SALINGER さんのコードだと下記です。
ActiveSheet.Unprotect Password:="aiueo" .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:=s ActiveSheet.Protect
コードに関しては、どちらが良い悪いではなく、人それぞれなので、
お好きなほうをどうぞ。
コメント欄よごすような事してスミマセンでした。
（だから、消したのですよね？）
http://dummy.hatena.ne.jp/またダミーです。
kn1967様
お世話になっております。
セルの保護件、早速教えて戴きありがとうございます。
これから試してみます。
1
1
1
SALINGER様
お世話になっております。マクロのコードありがとうございます。
セルA1～A5とC１～C6以外のセルに「メニュー」-「ツール」－「保護」で
ロックをかけた後、実行した場合
実行時エラー 2147417848（80010108）
Addメソッドは失敗しました。Validationオブジェクトと
が発生してしまうのですが、回避方法等はありますでしょうか？
有りましたらご教授して戴きたくよろしくお願い申し上げます。