1238245782 エクセルでドロップダウンまたはコンボボックスから値を選択するようにしたいのですが、その際にリストのデータに以下のように制限をかけたいのですが、可能でしょうか?

マクロ利用でもかまいませんので教えてください。お礼は300ポイント。

画像を利用して説明します。
詳細はコメントに書きます。

回答の条件
  • 1人3回まで
  • 登録:2009/03/28 22:09:45
  • 終了:2009/03/30 22:05:48

ベストアンサー

id:SALINGER No.3

SALINGER回答回数3454ベストアンサー獲得回数9692009/03/29 11:47:11

ポイント200pt

図と上のコメントだけで、2つ目のコメントを見てませんでした。

コンボボックスはF列まであるのですね。

その場合少し修正するだけで簡単です。


また、リストが他のシートにある場合でも、真ん中のFor~Nextを変更するだけで可能です。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Integer
    Dim str As String
    Dim myCol As Long
    
    If Intersect(Target, Range("A1:F4")) Is Nothing Then Exit Sub
    If Target.Count <> 1 Then Exit Sub
    
    myCol = Target.Column
    For i = 1 To 4
        Cells(i, myCol).Validation.Delete
    Next
    
    str = ""
    For i = 17 To 22
        If Cells(i, myCol).Value <> Cells(1, myCol).Value And _
            Cells(i, myCol).Value <> Cells(2, myCol).Value And _
            Cells(i, myCol).Value <> Cells(3, myCol).Value And _
            Cells(i, myCol).Value <> Cells(4, myCol).Value Then
            str = str & Cells(i, myCol).Value & ","
        End If
    Next i
    
    For i = 1 To 4
        With Cells(i, myCol).Validation
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:=Left(str, Len(str) - 1)
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .IMEMode = xlIMEModeNoControl
            .ShowInput = True
            .ShowError = True
        End With
    Next
End Sub

最初にコンボボックスを追加するコードも以下を実行させればいいです。

Sub ListInit()
    Dim i As Integer
    For i = 1 To 6
        Cells(1, i).Value = Cells(17, i).Value
    Next
End Sub
id:Ryo0524

ありがとうございます。

なんとかできました(^_^)

2009/03/30 22:03:13

その他の回答(2件)

id:Mook No.1

Mook回答回数1312ベストアンサー獲得回数3912009/03/28 23:48:02

ポイント200pt

コメントの仕様でマクロを作成してみました。

セルの値が変わった場合、関連セルのリストを動的に変更しています。

各列の100行-140行を作業領域に使用しています。

Private Sub Worksheet_Change(ByVal Target As Range)
    
    '// A1:F4だけを対象
    If Intersect(Target, Range("A1:F4")) Is Nothing Then Exit Sub
    '// 複数セルの変更は無視
    If Target.Count <> 1 Then Exit Sub

    Application.EnableEvents = False
    
    Dim lName As String
    Dim i As Long, j As Long
    
    Dim r As Long, c As Long
    c = Target.Column
    
    Dim res As Range
    Dim subList As Range
    
    '// 各列の100行以降をリスト用の作業列にしよう
    Cells(100, c).Resize(40, 1).Clear
    For i = 1 To 4
        Set subList = Cells(100, c).Offset(10 * (i - 1), 0).Resize(6, 1)
        subList.Value = Cells(17, c).Resize(6, 1).Value
    
        j = subList.Row + subList.Count - 1
        For r = 1 To 4
            If Cells(r, c) <> "" Then
                Set res = subList.Find(Cells(r, c), lookat:=xlWhole)
                If Not res Is Nothing Then
                    If res.Value <> Cells(i, c).Value Then
                        res.Resize(6, 1).Value = res.Offset(1, 0).Resize(6, 1).Value
                        j = j - 1
                    End If
                End If
            End If
        Next
    '// リスト用の名前を設定
        lName = "SUB_List" & i & "_" & c
        On Error Resume Next
        ActiveWorkbook.Names(lName).Delete
        On Error GoTo 0
        ActiveWorkbook.Names.Add Name:=lName, RefersToR1C1:="=" & ActiveSheet.Name & "!R" & subList.Row & "C[0]:R" & j & "C[0]"
        
    
    '// 同じ列のセルのリストを設定
        With Cells(i, c)
            .Validation.Delete
            .Validation.Add Type:=xlValidateList, Operator:=xlBetween, Formula1:="=" & lName
        End With
    Next
    Application.EnableEvents = True
End Sub

不明な点はコメントください。

id:Ryo0524

ありがとうございます。

上記のマクロをエクセルに設定後、A1からA4、B1からB4、…F1からF4にリストボックスを作成するだけでよいのでしょうか?

もし、そうだとしたら、リストボックスは入力規則を使用して作成することで問題ないですか?

2009/03/29 00:08:09
id:SALINGER No.2

SALINGER回答回数3454ベストアンサー獲得回数9692009/03/29 00:56:52

Validation.Deleteがうまく実行されない可能性もありますが、私の環境では普通にこれでいけました。

初期処理として、最初だけA1に何か書き込むと、リストボックスが生成されます。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Integer
    Dim str As String
    
    If Intersect(Target, Range("A1:A4")) Is Nothing Then Exit Sub
    If Target.Count <> 1 Then Exit Sub
    
    For i = 1 To 4
        Cells(i, 1).Validation.Delete
    Next
    
    str = ""
    For i = 17 To 22
        If Cells(i, 1).Value <> Range("A1").Value And _
            Cells(i, 1).Value <> Range("A2").Value And _
            Cells(i, 1).Value <> Range("A3").Value And _
            Cells(i, 1).Value <> Range("A4").Value Then
            str = str & Cells(i, 1).Value & ","
        End If
    Next i
    
    For i = 1 To 4
        With Cells(i, 1).Validation
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:=Left(str, Len(str) - 1)
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .IMEMode = xlIMEModeNoControl
            .ShowInput = True
            .ShowError = True
        End With
    Next
End Sub
id:Ryo0524

ありがとうございます。

上記のマクロを設定したのですが、そもそもリストボックスが生成されません…。

たぶんわたしのやり方がおかしいのだとは思いますが・・・。

いまは、上記のマクロを設定後、A1に卒業見込と入力してみました。

2009/03/29 08:40:17
id:SALINGER No.3

SALINGER回答回数3454ベストアンサー獲得回数9692009/03/29 11:47:11ここでベストアンサー

ポイント200pt

図と上のコメントだけで、2つ目のコメントを見てませんでした。

コンボボックスはF列まであるのですね。

その場合少し修正するだけで簡単です。


また、リストが他のシートにある場合でも、真ん中のFor~Nextを変更するだけで可能です。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Integer
    Dim str As String
    Dim myCol As Long
    
    If Intersect(Target, Range("A1:F4")) Is Nothing Then Exit Sub
    If Target.Count <> 1 Then Exit Sub
    
    myCol = Target.Column
    For i = 1 To 4
        Cells(i, myCol).Validation.Delete
    Next
    
    str = ""
    For i = 17 To 22
        If Cells(i, myCol).Value <> Cells(1, myCol).Value And _
            Cells(i, myCol).Value <> Cells(2, myCol).Value And _
            Cells(i, myCol).Value <> Cells(3, myCol).Value And _
            Cells(i, myCol).Value <> Cells(4, myCol).Value Then
            str = str & Cells(i, myCol).Value & ","
        End If
    Next i
    
    For i = 1 To 4
        With Cells(i, myCol).Validation
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:=Left(str, Len(str) - 1)
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .IMEMode = xlIMEModeNoControl
            .ShowInput = True
            .ShowError = True
        End With
    Next
End Sub

最初にコンボボックスを追加するコードも以下を実行させればいいです。

Sub ListInit()
    Dim i As Integer
    For i = 1 To 6
        Cells(1, i).Value = Cells(17, i).Value
    Next
End Sub
id:Ryo0524

ありがとうございます。

なんとかできました(^_^)

2009/03/30 22:03:13
  • id:Ryo0524
    ・A1のセルに入力する値をドロップダウンリストから選択します
     その際のリストデータはA17からA22の値です
     (大学卒業、大学院卒業、大学卒業見込、大学院卒業見込、専門学校卒業、専門学校卒業見込)
    ・A2のセルに入力する値をドロップダウンリストから選択します
     その際のリストデータはA1で選択した値をのぞくA17からA22の値です
      たとえば、A1で大学卒業を選択していたらA2で選択できる値は『大学院卒業、大学卒業見込、大学院卒業見込、専門学校卒業、専門学校卒業見込』になります
      ※画像ではその制限のかけかたができなかったのでA2でも「大学卒業」もリストの値に入ってしまっています…
    ・A3のセルに入力する値をドロップダウンリストから選択します
     その際のリストデータはA1、A2で選択した値をのぞくA17からA22の値です
    ・A4のセルに入力する値をドロップダウンリストから選択します
     その際のリストデータはA1、A2、A3で選択した値をのぞくA17からA22の値です
  • id:Mook
    A1からA4はかならず上から下への入力ですか?
    またシートの構成は上記の例の用で、このルールを適用するのはA1:A4だけでしょうか?
  • id:Ryo0524
    >A1からA4はかならず上から下への入力ですか?
    ⇒上から下という規則はないです。
     A1を入力後、A4を入力してからA2を入力するという場合もあります。
     A1からA4の中で値の重複をさけたいのです。

    >またシートの構成は上記の例の用で、このルールを適用するのはA1:A4だけでしょうか?
    ⇒A1からA4に使用するデータのリストはA17からA22に入力されている値
     B1からB4に使用するデータのリストはB17からB22に入力されている値
     C1からC4に使用するデータのリストはC17からC22に入力されている値
     以下F列まで続きます


    もし、リストの選択肢を制限できないのであれば、すでに選択されている値をリストから選択した場合は「警告を表示する」でもよいのですが・・・
    わかりましたら教えてください。

  • id:Mook
    初期状態を設定するルーチンです。
    最初に一度だけ、下記を実行してください。

    Sub ListInit()
      Dim r As Long, c As Long
      Dim lName As String
      For c = 1 To 6
        lName = "MAIN_List" & c
        On Error Resume Next
        ActiveWorkbook.Names(lName).Delete
        On Error GoTo 0
        ActiveWorkbook.Names.Add Name:=lName, RefersToR1C1:="=" & ActiveSheet.Name & "!R17C[0]:R22C[0]"
        For r = 1 To 4
          With Cells(r, c)
            .Validation.Delete
            .Validation.Add Type:=xlValidateList, Operator:=xlBetween, Formula1:="=" & lName
          End With
        Next
      Next
    End Sub
  • id:Ryo0524
    ありがとうございます。
    上記のマクロを実行したらリストボックスが作成されました。
    でも、リストの選択肢に制限がかからないのですが、なにか特別な設定とかありますか?
    質問ばかりですみません…
  • id:Mook
    それ以外の値の入力を禁止するには、最後から5行目の
      .Validation.Add Type:=xlValidateList, Operator:=xlBetween, Formula1:="=" & lName
    の後に
      .Validation.InCellDropdown = True
    を追加してください。
  • id:Ryo0524
    A1で「卒業見込」を選択しても、A2でも「卒業見込」が選択できてしまいます。
    わたしのやり方がおかしいのでしょうか…
  • id:Mook
    上記のコメントは、どちらでのお話ですか?
    私の環境では、どちらもそれらしく動いているように見えますが。

    一点、私の方で工夫したのは、既に設定されている場所はその設定値も
    リストに含むようにしています。
    なので各セルでの選択項目は、未選択項目+自分自身の項目となってます。


    今回の構成だったら、SALINGER さんの方法が簡単でしたね。
    (最後に, が余計についても動作的に影響ないんですね。)
    リストの設定はマクロの記録のままだとうまく動かないケースですが、
    今回のように Delete と Add を独立してあげれば後はそのままで動きますね。

    参照先のシートが異なった場合は、名前を使用するとLISTで使用可能です。
    当初同じリストを複数個所で使用し、リスト自体は別シートで管理する
    ことを想定していたので、複雑な構成にしてしまいました。
  • id:SALINGER
    >上記のマクロを設定したのですが、そもそもリストボックスが生成されません…。
    A1~A4セルに最初にコンボボックスを設定する手間は必要なく、
    マクロ自体がA1~A4にリストを設定しなおすマクロなので、
    最初に1度A1~A4のどこかに入力してマクロを実行させればコンボボックスは設定されます。

    >今回のように Delete と Add を独立してあげれば後はそのままで動きますね。
    Mookさんが以前入力規則に関する質問で回答されていたように、DeleteとAddを一緒に書くと
    変更されないことがあるのかもしれません。
    ちなみに私の環境ではDeleteとAddを一緒に書いてもちゃんと変更されていることを考えると、
    パソコン環境によって変更されないことがあるのかも。
  • id:Mook
    >ちなみに私の環境ではDeleteとAddを一緒に書いてもちゃんと変更されていることを考えると、
    そうですか。であれば、リストは問題ないかも知れませんね。

    チャートでの経験から、私は同じオブジェクトに対して削除と作成は分離するようにしていたので、
    リストに関しては未確認情報です。すみません(動作的には問題ないはずなので)。

    大丈夫とは思いますが、SALINGER さんと 私のコードは同じシートイベントですので同居できません
    から、別のシートでお試しください。
    また、A1で試したとあるので大丈夫だとは思いますが、SALINGERさんのはA列を対象としているので
    B列以降で使用する場合は、最初の条件判定を変更する必要があります。

    あるいは念のために、
    Sub EnableEvent()
    Application.EnableEvents = True
    End Sub
    を実行してみてから、試してはどうでしょうか。
  • id:Ryo0524
    おふたりとも本当にありがとうございます。
    お二人のコメントもとても勉強になりました。

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

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

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

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