excel マクロの作成に関してご教授お願い申し上げます。

入力条件付きドロップダウンリスト

セルA1からA5に入力する方法はドロップダウンリストで
そのリストデータは、セルC1~C6の値
(リストの内容:サンプル1,サンプル2,サンプル23,サンプル4,サンプル5,サンプル6,)
とします。

そこで、例えば
(1)セルA1にて”サンプル1”をドロップダウンリストで選択します。
(2)セルA2においてのドロップダウンリストの内容は、
 既にセルA1で選択された”サンプル1”を除く、(サンプル2,サンプル23,サンプル4,サンプル5,サンプル6)
 とし
(3)セルA3においてのドロップダウンリストの内容は、セルA1、セルA2で選択されたものを除く
(4)セルA4においてのドロップダウンリストの内容は、セルA1、セルA2、セルA3で選択されたものを除く
(5)セルA5においてのドロップダウンリストの内容は、セルA1、セルA2、セルA3、セルA4で選択されたものを除く

と言ったようなことをエクセルマクロでできるでしょうか?
マクロ初心者な為、ご教授宜しくお願い申し上げます。

また入力する順番は、以下のの2通りを考えております。

(1) A1→A2→A3→A4→A5
(2) ランダム

回答の条件
  • URL必須
  • 1人10回まで
  • 登録:2009/12/15 22:28:35
  • 終了:2009/12/22 22:30:02

ベストアンサー

id:SALINGER No.1

SALINGER回答回数3454ベストアンサー獲得回数9692009/12/16 00:02:51

ポイント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にサンプル1~サンプル6と書き込み、

そのままでは最初リストは設定されていないのでA1セルに適当な文字を入力すると

A1~A5にリストが自動的に設定されます。

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

id:hawk007

SALINGER様

お世話になっております。マクロのコードありがとうございます。

セルA1~A5とC1~C6以外のセルに「メニュー」-「ツール」-「保護」で

ロックをかけた後、実行した場合

実行時エラー 2147417848(80010108) 

Addメソッドは失敗しました。Validationオブジェクトと

が発生してしまうのですが、回避方法等はありますでしょうか?

有りましたらご教授して戴きたくよろしくお願い申し上げます。

2009/12/16 14:34:42

その他の回答(2件)

id:SALINGER No.1

SALINGER回答回数3454ベストアンサー獲得回数9692009/12/16 00:02:51ここでベストアンサー

ポイント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にサンプル1~サンプル6と書き込み、

そのままでは最初リストは設定されていないのでA1セルに適当な文字を入力すると

A1~A5にリストが自動的に設定されます。

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

id:hawk007

SALINGER様

お世話になっております。マクロのコードありがとうございます。

セルA1~A5とC1~C6以外のセルに「メニュー」-「ツール」-「保護」で

ロックをかけた後、実行した場合

実行時エラー 2147417848(80010108) 

Addメソッドは失敗しました。Validationオブジェクトと

が発生してしまうのですが、回避方法等はありますでしょうか?

有りましたらご教授して戴きたくよろしくお願い申し上げます。

2009/12/16 14:34:42
id:kn1967 No.2

kn1967回答回数2915ベストアンサー獲得回数3012009/12/16 00:10:48

ポイント27pt

(1)VBAの例

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

※このコードは標準モジュールではなく、シートのモジュールに貼り付けて使ってください。


(2)VBAを使わない例 基本型

A B C D
1 サンプル1 =IF(COUNTIF($A$1:$A$6,C1)=0,C1,"")
2 サンプル2   ↓下方向コピー
3 サンプル3   ↓下方向コピー
4 サンプル4   ↓下方向コピー
5 サンプル5   ↓下方向コピー
6 サンプル6   ↓下方向コピー

上記を入力したら「A1からA5までを選択」して「データ→入力規則 → 設定」と進み、

入力値の種類は「リスト」元の値に「=$D$1:$D$6」を入力してOK。

これで設定完了。


(3)VBAを使わない例 応用

A B C D E
1 サンプル1 =IF(COUNTIF($A$1:$A$6,C1)=0,C1,"") =ROWS($D$1:$D$6)-COUNTBLANK($D$1:$D$6)
2 サンプル2   ↓下方向コピー =VLOOKUP("*?",$D$1:$D$6,1,)
3 サンプル3   ↓下方向コピー =VLOOKUP("*?",INDEX($D$1:$D$6,MATCH(E2,$D$1:$D$6,)+1):$D$6,1,)
4 サンプル4   ↓下方向コピー   ↓下方向コピー
5 サンプル5   ↓下方向コピー   ↓下方向コピー
6 サンプル6   ↓下方向コピー   ↓下方向コピー
7   ↓下方向コピー

上記を入力したら「A1からA5までを選択」して「データ→入力規則 → 設定」と進み、

入力値の種類は「リスト」元の値に「=OFFSET($E$2,,,$E$1,)」を入力してOK。

これで設定完了。D列E列は動作確認ができたら非表示にしておくと良いでしょう。

※E列のみ1行目にて表示行数を計算しているので下方向に一段ズレます。


http://dummy.hatena.ne.jp/ダミーです。

id:hawk007

kn1967様

お世話になっております。

マクロのコードとマクロ以外の方法ありがとうございます。

マクロのほうで、

お世話になっております。マクロのコードありがとうございます。

セルA1~A5とC1~C6以外のセルに「メニュー」-「ツール」-「保護」で

ロックをかけた後、実行した場合

実行時エラー 2147417848(80010108) 

Addメソッドは失敗しました。Validationオブジェクトと

が発生してしまうのですが、回避方法等はありますでしょうか?

可能ならば、入力するセル以外はロックをかけ保護したいと思っております。

有りましたらご教授して戴きたくよろしくお願い申し上げます。

マクロ以外の方の動作はこれから試してみます。

2009/12/16 14:42:33
id:kn1967 No.3

kn1967回答回数2915ベストアンサー獲得回数3012009/12/16 15:39:25

ポイント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/またダミーです。

id:hawk007

kn1967様

お世話になっております。

セルの保護件、早速教えて戴きありがとうございます。

これから試してみます。

2009/12/16 15:52:32

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません