別シートデータからの重複のない入力規則リスト作成

質問

エクセルで、入力規則のリスト作成に関してご教示ください。
別シートにて、以下のようにC列にデータがあります。
データ数は可変です。

A列 B列 C列
No 種別 データ
1 A データA
2 A データA
3 A データA
4 A データB
5 C データC
6 A データB
7 C データB
　　　　：
　　　　：

上記データを使用して、入力規則で、リスト作成をしたいのです。

=OFFSET(シートA!$A$2,0,0,COUNTA(シートA!$A:$A)-1,1)
上記式を名前定義して、リストに設定した場合には、重複したリスト表示が
されてしまします。

名前定義を使ってどう設定すれば、重複をしないリストづくり可能でしょうか。

回答No.3

kagakusuki · ベストアンサー

>別途重複のないリストを作ること（セル上に新たに表を作成）「なし」でリストを作りたい（入力規則に設定したい）

という事は、回答No.2様の方法の様な別シートに重複のないリストを作る方法も駄目だという事でしょうか？
（因みに、別シートにリストを作っても良いのでしたら、マクロなど使わずとも、回答No.1の方法で重複の無いリストを作ってから、E列～G列の全体を切り取り、別シートの適当な列の所に、[切り取ったセルの挿入]で挿入するだけで事足ります）
　もし、別途にリストを作る事が一切駄目だと仰るのでしたら、マクロを使うより他に方法は無い様に思います。

　以下は、別途にリストを作成する事無く、重複の無い入力規則のドロップダウンリストを設定するVBAのマクロの一例です。
　但し、御質問文には、「どのセルに入力規則を設定すれば良いのか」という事に関する情報が御座いませんでしたので、取り敢えずとして、入力規則を設定するセルがどのセルであるのかを、毎回訊いて来る様なマクロとしております。
　それから、シートAのC列のデータが変更されて、入力規則のドロップダウンリストに表示すべき内容が変わった場合であっても、マクロを再起動させない間は、シートAのC列の最新の状態がドロップダウンリストに反映される事はありませんから、シートAのC列のデータを変更する度に、マクロを再起動させる必要があります。（入力規則を設定すべきセルがどのセルであるのか不明なため、仕方がありません）

Sub 重複の無いドロップダウンリスト()

Dim c As Range
Dim a As Variant
Dim LR As Long
Dim l As String

LR = Application.Evaluate("=MAX(IF(COUNT(シートA!C:C),MATCH(9E+307,シートA!C:C ),0),IF(COUNTIF(シートA!C:C,""*?""),MATCH(""*?"",シートA!C:C,-1),0))")
If LR <= Range("C1").Row Then Exit Sub
Cells(2, Rows.Columns.Count).Value = Sheets("シートA").Range("C2").Value
Cells(3, Rows.Columns.Count).Resize(LR - Sheets("シートA").Range("C2").Row).FormulaR1C1 = _
"=R[-1]C&IF(OR(シートA!RC3="""",COUNTIF(シートA!R2C3:R[-1]C3,シートA!RC3)),"""","",""&シートA!RC3)"
l = Cells(LR, Rows.Columns.Count).Value
Columns(Rows.Columns.Count).Clear
On Error GoTo label1
label2:
Set c = Application.InputBox(Title:="入力規則の設定対象", prompt:="入力規則を設定するセル或いはセル範囲を選択して下さい。" & Chr(10) & "　　(複数選択可)", Default:=Selection.Address(ReferenceStyle:=xlA1), Type:=8)
c.Select
a = MsgBox("以下のセル" & Chr(10) & Chr(10) & c.Address(ColumnAbsolute:=False, RowAbsolute:=False, ReferenceStyle:=xlA1) & Chr(10) & Chr(10) & "に対して入力規則を設定します。" & Chr(10) & "宜しいですか？" & Chr(10) & Chr(10) & "[はい]⇒入力規則の設定を実行" & Chr(10) & "[いいえ]⇒入力規則を設定するセルの選択をやり直し" & Chr(10) & "[キャンセル]⇒マクロの終了", vbYesNoCancel)
Select Case a
Case Is = 2
GoTo label1
Case Is = 7
GoTo label2
Case Is <> 6
GoTo label1
End Select
With c.Validation
.Delete
.Add Type:=xlValidateList, Formula1:=l
End With

label1:
End Sub

お礼

お礼が遅くなり申し訳ございません。
サンプルコードありがとうございます。
マクロもいいのですが、できれば入れたくないので、
やはり、別シートなりといったところで、重複なしの表を作るしかないようですね。
ありがとうございました。

回答No.2

tom04

こんばんは！

苦肉の策ですが

＞名前定義を使ってどう設定すれば、重複をしないリストづくり・・・

名前定義ではなく別Sheetに重複なしに表示しておき
それを参照するのが手っ取り早いと思います。
作業用のSheet（参照先のSheet）としてSheet3を使用していますので、
Sheet3は使用していない状態にしておいてください。

まず入力規則のリストの設定をしているSheet見出し上で右クリック　→　コードの表示　→　VBE画面に
↓のコードをコピー＆ペーストしてマクロを実行しておいてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub フィルタ() 'この行から
With Worksheets("シートA")
.Range("C:C").AdvancedFilter Action:=xlFilterInPlace, unique:=True
.Range("C:C").Copy Worksheets("Sheet3").Range("A1")
.ShowAllData
End With
End Sub 'この行まで

これでSheet3のA列に「シートA」のC列が重複なしに表示されますので、
これを利用します。

リスト表示させたいセルを範囲指定　→　データの入力規則　→　元の値の欄に
=OFFSET(Sheet3!A$1,1,,COUNTA(Sheet3!A:A)-1)
という数式を入れてみてください。

この程度しか思いつきませんが、他に良い方法があればごめんなさいね。m(_ _)m

お礼

お礼が遅くなり申し訳ございません。
サンプルコードありがとうございます。
マクロもいいのですが、できれば入れたくないので、
やはり、別シートなりといったところで、重複なしの表を作るしかないかなと考えてます。
何らかの工夫で出来そうな気もしてるんですが。。。

回答No.1

kagakusuki

作業列を使って重複の無いリストを作成し、その重複の無いリストを使って入力規則のリストを作成されると良いと思います。

　まず、シートAのE2セルに次の関数を入力して下さい。

=IF(INDEX($C:$C,ROW())="","",IF(COUNTIF($C$1:INDEX($C:$C,ROW()),INDEX($C:$C,ROW()))=1,ROW(),""))

　次に、シートAのE2セルをコピーして、シートAのE3以下に(シートAのC列のリストの行数を上回るのに十分な行数となる様に)貼り付けて下さい。

　次に、シートAのG2セルに次の関数を入力して下さい。
　次に、シートAのG2セルをコピーして、シートAのG3以下に(シートAのC列に入力されているデータの種類の数を上回るのに十分な行数となる様に)貼り付けて下さい。

=IF(ROWS($2:2)>COUNT($E:$E),"",INDEX($C:$C,SMALL($E:$E,ROWS($2:2))))

　そして、入力規則を設定する際には、「データの入力規則」ダイアログボックスの「設定」タブの「入力値の種類」欄を[リスト]とした際に現れる、「元の値」欄に次の様な数式を入力されると良いと思います。

=INDIRECT("シートA!G2:G"&ROW(INDIRECT("シートA!G1"))+COUNT(INDIRECT("シートA!E:E")))

補足

ありがとうございます。
一旦重複のないリストを作り意図したところはできましたが、最終的に実現したいのは、
別途重複のないリストを作ること（セル上に新たに表を作成）「なし」でリストを作りたい
（入力規則に設定したい）のですができないでしょうか。