データの入力規則の値をフィルタで絞った範囲を指定

質問

エクセル2010を使用しています。

データの入力規則の元の値を、フィルタで絞り重複したレコードを無視した状態を使用する事ってできないでしょうか。
どこかのサイトに計算式と作業列を使用すれば可能なのは見かけたのですが、VBAでやりたいのです。
そもそも元の値にフィルタで絞った値が指定できないので何か別の方法がないかと思っている次第です。

回答No.3

watabe007 · ベストアンサー

VBAで書いてみました。
フィルタのリストはSheet1のD5から下に続くものとしています。
入力規則のセルはA1と仮定しています。
SelectionChangeイベントを利用しますので以下をシートモジュールに
書いてください。
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
　　Dim myDic As Object
　　Dim FR As Range, c As Range, myList As String
　　If Target.Address(0, 0) <> "A1" Then Exit Sub
　　With Worksheets("Sheet1")
　　　　Set myDic = CreateObject("Scripting.Dictionary")
　　　　For Each c In .Range("D5", .Cells(Rows.Count, "D").End(xlUp))
　　　　　　If c.EntireRow.Hidden = False Then
　　　　　　　　myDic(c.Value) = Empty
　　　　　　End If
　　　　Next
　　　　myList = Join(myDic.keys, ",")
　　　　With Target.Validation
　　　　　　.Delete
　　　　　　.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
　　　　　　　　Operator:=xlBetween, Formula1:=myList
　　　　　　.IgnoreBlank = True
　　　　　　.InCellDropdown = True
　　　　　　.InputTitle = ""
　　　　　　.ErrorTitle = ""
　　　　　　.InputMessage = ""
　　　　　　.ErrorMessage = ""
　　　　　　.IMEMode = xlIMEModeNoControl
　　　　　　.ShowInput = True
　　　　　　.ShowError = True
　　　　End With
　　　　Set myDic = Nothing
　　End With
End Sub

お礼

ご回答ありがとうございます。

こちらもおもしろいですね。
これは連想配列の特性を利用しているのでしょうか？
できれば解説をお願いしたい箇所がありまして、ForEachの中のIFなのですが、これは何か意味があるのでしょうか？

回答No.4

watabe007

>ForEachの中のIFなのですが、これは何か意味があるのでしょうか？
リストと仮定した D5セルから D列の最終行まで変数C代入してCが可視セルか判定ています。
Cの単体セルではHiddenが反応しないのでCが置かれている行全体(c.EntireRow)で可視の判定をしています。

お礼

ご回答ありがとうございます。

私の書き方が悪かったです。
IF分が無かったとしても、私がテストした限りだと同じ結果になったので、Hiddneの判定に何か特別な意味があるのかと思い伺った次第です。

回答No.2

HohoPapa

>VBAでやりたいのです
VBAで作ってみました。

>フィルタで絞り重複したレコードを無視した状態
これは、
フィルターで絞った状態で重複があるので、
更に、
この重複を排除して、入力規則の候補一覧に並べたい
と理解しました。

添付画像を例にすれば、こんなコードになるだろうと思います。

なお、
このマクロをどのタイミング（イベント）で実行するかを考える必要があります。
フィルターをかける一覧と、入力規則を設定するシートが同一の場合
Worksheet_SelectionChange　が候補になるだろうと思うものの
それだけでは不十分かもしれません。

他方、
フィルターをかける一覧と、入力規則を設定するシートが別であれば
Worksheet_Activate　で実行すれば十分と思います。

Sub ChgList()

　Dim RowCounter As Long
　Dim SelList As String

　RowCounter = 4
　SelList = ""

　With ThisWorkbook.Sheets(1)
　　Do
　　　If .Cells(RowCounter, 4).Value = "" Then Exit Do
　　　If .Rows(RowCounter).Hidden = False Then
　　　　If SelList = "" Then
　　　　　SelList = .Cells(RowCounter, 4).Value
　　　　Else
　　　　　If InStr(SelList, .Cells(RowCounter, 4).Value) = 0 Then
　　　　　　SelList = SelList & "," & .Cells(RowCounter, 4).Value
　　　　　End If
　　　　End If
　　　End If
　　　RowCounter = RowCounter + 1
　　Loop
　End With

　With ThisWorkbook.Sheets(1)
　　With .Cells(3, 6).Validation
　　　.Delete
　　　.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
　　　　 Operator:=xlBetween, Formula1:=SelList
　　　.IgnoreBlank = False
　　　.InCellDropdown = True
　　　.InputTitle = ""
　　　.ErrorTitle = ""
　　　.InputMessage = ""
　　　.ErrorMessage = ""
　　　.IMEMode = xlIMEModeNoControl
　　　.ShowInput = True
　　　.ShowError = True
　　End With

　End With

End Sub

お礼

ご回答ありがとうございます。

表示されている行のセルの値を連結してそれを元の値とする方法ですか。
おもしろいですね。

参考にさせて頂きます。

回答No.1

watabe007

>VBAでやりたいのです
関数でできますよ
A列に元のリストがあり、D列に重複しないリストを作ります。
D2に　=A2
D3に　=IFERROR(VLOOKUP("*",IF(COUNTIF(D$2:D2,$A$2:$A$15)=0,$A$2:$A$15),1,FALSE),"")
式入力確定時に[Ctrl]+[Shift]+[Enter]で配列数式として入力します。
以下にドラッグ
　 A列　　　　　　D列
1　品名　　　　　品名
2 　パパイヤ　　　パパイヤ
3 　バナナ　　　　バナナ
4 　マンゴー　　　マンゴー
5 　パパイヤ　　　メロン
6 　バナナ　　　　レモン
7　メロン　　　　　スイカ
8　レモン
9　スイカ
10　マンゴー
11　レモン
12　メロン
13　メロン
14　バナナ
15　メロン

補足

ご回答は有難いのですが、質問にも書いてあるとおり計算式を使用する方法は存じ上げております。