人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

excelの入力条件付きドロップダウンリストのマクロの件では
先日SALINGER様、kn1967様に大変お世話になりました。
http://q.hatena.ne.jp/1260883712
セルA1?A5に入力する方法はドロップダウンリスト
リストデータ(例)は、セルC1?C6の値(100,85,70,55,40,25)
とし先日教授戴きましたマクロを改造?して以下の様な
ことをexcelマクロで出来るでしょうか?
例えば、セルA1にて85をドロップダウンリストで選択した場合、
次のセルA2においてのドロップダウンリストの内容は、70,55,40,25
そこでセルA2にて55をドロップダウンリストで選択した場合、
次のセルA3にてのドロップダウンリストの内容は、40,25
必ず、先に入力したセルの値より小さい値を選択入力する様な仕様。
入力順番は、ランダム又はA1→A2…A5固定
リストデータの最小値を入力したセル以降のセルでは、
ドロップダウンリストを表示させない。または空白のリストにする。
ご教授宜しくお願い申し上げます。


●質問者: hawk007
●カテゴリ:コンピュータ
✍キーワード:A1 A3 Excel セル データ
○ 状態 :終了
└ 回答数 : 2/2件

▽最新の回答へ

1 ● SALINGER
●40ポイント ベストアンサー

例えば25を選択すると次に何も選択できなくなってしまうので

また全部選択できる仕組みいれないといけないですね。

それで、C列に無いデータ(空白など)を入力するとまた100から選択できようにしました。


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
 
 If Columns("C").Find(Target.Value, lookat:=xlWhole) Is Nothing Or Target.Value = "" Then
 j = 1000  'C列よりも大きな数字
 Else
 j = Target.Value
 End If
 
 For i = 1 To 6
 If j > Cells(i, "C").Value Then
 s = s & "," & Cells(i, "C").Value
 End If
 Next i

 Range("A1:A5").Validation.Delete
 
 If s = "" Then s = "ALL"
 
 With Range("A1:A5").Validation
 .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
 xlBetween, Formula1:=s
 .IgnoreBlank = True
 .InCellDropdown = True
 .InputTitle = ""
 .ErrorTitle = ""
 .InputMessage = ""
 .ErrorMessage = ""
 .IMEMode = xlIMEModeNoControl
 .ShowInput = True
 .ShowError = False
 End With
End Sub

http://q.hatena.ne.jp/


2 ● kn1967
●40ポイント

Set の2行によって範囲の指定を一箇所に集めて、

前回のものより応用を利かせやすくしてみました。

※最小が入力された時点でドロップダウンリストは出なくなる仕様です。

※最小のセル(25)を消した時点でドロップダウンリストは復活します。

※コメント欄が開いてないので、ここで質問しますが、

ランダムに書き込んだ際には番号が必ずしも降順にならない仕様です。

それでよろしいでしょうか? このあたりの仕様が判らなかったので、

改良が必要ならコメント欄にでも変更分だけ書き込みますので、お返事ください。

Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Column = 1 And Target.Row >= 1 And Target.Row <= 5 Then
 Dim aRange As Range, cRange As Range, c As Range
 Dim pickupList As String, minValue As Long, i As Long
 
 Set aRange = Range("A1:A5")
 Set cRange = Range("C1:C6")
 minValue = Application.WorksheetFunction.min(aRange)
 
 If minValue = Application.WorksheetFunction.min(cRange) Then
 aRange.Validation.Delete
 Else
 pickupList = ""
 For Each c In cRange
 If minValue = 0 Or minValue > c.Value Then
 pickupList = pickupList & "," & c.Value
 End If
 Next
 pickupList = Mid(pickupList, 2)
 With aRange.Validation
 .Delete
 ActiveSheet.Unprotect Password:="aiueo"
 .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=pickupList
 ActiveSheet.Protect
 .IgnoreBlank = True
 .InCellDropdown = True
 .InputTitle = ""
 .ErrorTitle = ""
 .InputMessage = ""
 .ErrorMessage = ""
 .IMEMode = xlIMEModeNoControl
 .ShowInput = True
 .ShowError = True
 End With
 End If
 End If
End Sub

http://dummy.hatena.ne.jp/ダミー

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ