エクセルで他のBookのデータを入力規則のリストに…

エクセル（Excel2002）の入力規則についての質問です。
仮にBook1のsheet1のA列1～10行に元の値となるデータを作成し，これに「データ」と名前をつけます。
このデータをBook1とは異なるBook2のA列1行において入力規則の元のデータに設定しドロップダウンリストから選択することは可能でしょうか？
Book1とBook2は同一フォルダにあります。
ご教示ください。

No.6 ベストアンサー 回答者： KenKen_SP 回答日時： 2005/09/27 01:14

#5 です。

バグ発見です。すみません。

#5 のコードを次のように訂正します。

（誤）
　　'データ範囲の名前をチェック
　　Set rngDat = WB.Names("データ").RefersToRange

（正）
　　'データ範囲の名前をチェック
　　Set rngDat = WB.Names(DatRangName).RefersToRange

No.5 回答者： KenKen_SP 回答日時： 2005/09/26 23:44

こんにちは。

KenKen_SP です。

お返事遅くなり、すみません。

> やはりVBAを使わなければ無理ですか…。

いえ、#1 の方の方法を使えば、VBA なしでも可能なのですが、今回の
場合、リンクを張っていくのにとにかく根気が必要でしょう。

> 自分がやろうとしていることは，ExcelではなくAccessでやるべきこと
> なのでしょうか！？

Access を使っても良いのですが、現実的には 「Excel の方が慣れて
いるので、できれば Excel で、、」との声があがってきそうです。
また、Access VBA も決して簡単ではありませんし、今回の場合、もっと
難易度の高いものになりそうです。

それならば、Excel VBA を使って可能な限り楽をしようかと、、

#3 のコードはイマイチ不完全燃焼なので、書き直してみました。コー
ドが長いのはエラー処理を充実させたためですから、実際にやっている
ことはたいした事ではありません。

マクロ（VBA）が使用可能な状況がどうか分かりませんが、手順などを
記載しておきますので、よろしければ一度お試し下さい。

【使い方】

ブックを開くと「リストを更新するか？」と聞いてきますので、[OK]
をクリックすると参照先ブックからデータを読み取って、入力規則を
自動設定します。即時更新が必要ならマクロ「リスト更新」をその時
に実行して下さい。

【注意】
　・参照先ブックは同一フォルダ内において下さい。
　・参照先ブック名やシート名などを予め決めておく必要があります。
　　コード中の　Setting Param を必要なら修正し、調整して下さい。
　・まずはテスト用ブックで動作確認して下さい。つまり、自己責任で
　　お願いします。（←ここ重要）

【手順】

1.　入力規則を設定するブックのみを開く（他は閉じて下さい）
2.　[Alt]+[F11]キー押下で Visual Basic Editor が開く（以下 VBE）
3.　VBE のメニューから[挿入]-[標準モジュール]をクリック
4.　開いたスペースに以下のコードをコピー＆ペースト
5.　VBE 閉じる
6.　ブックを保存し、一度閉じます
7.　再度ブックを開いて動作を確認します

’以下コード

Sub Auto_Open()

　　Call リスト更新

End Sub

Sub リスト更新()

　　Dim Dummy　　As Variant
　　Dim WB　　　 As Workbook
　　Dim SH　　　 As Worksheet
　　Dim rngDat　 As Range
　　Dim rngCel　 As Range
　　Dim lngR　　 As Long
　　Dim sAddress As String
　　
　　'--------------------------------------------------- Setting Param -------
　　'参照元ブック名
　　Const DatBookName As String = "Book1.xls"
　　'参照元ブックデータ範囲の名前
　　Const DatRangName As String = "ListData"
　　'作業用シート名
　　Const sTempShName As String = "_ListTempData"
　　'入力規則を設定するシート名
　　Const sTargetName As String = "Sheet1"
　　'-------------------------------------------------------------------------
　　
　　'更新確認
　　lngR = MsgBox("リストを最新の情報に更新しますか？", vbInformation Or vbOKCancel, "確認")
　　If lngR = vbCancel Then
　　　　Exit Sub
　　End If
　　
　　On Error Resume Next
　　Application.ScreenUpdating = False
　　'ダミーアクセスでブックの状態をチェック
　　Dummy = Workbooks(DatBookName).Sheet1.Range("A1").Value
　　If Err.Number > 0 Then
　　　　'エラー発生ならブックを開く
　　　　Err.Clear
　　　　Workbooks.Open Filename:=ThisWorkbook.Path & "\" & DatBookName
　　　　If Err.Number > 0 Then
　　　　　　strMes = "参照先ブック[ " & DatBookName & " ]が見つかりません"
　　　　　　GoTo ErrorHandler
　　　　End If
　　End If
　　Err.Clear
　　Set WB = Workbooks(DatBookName)
　　
　　'データ範囲の名前をチェック
　　Set rngDat = WB.Names("データ").RefersToRange
　　If Err.Number > 0 Then
　　　　strMes = "参照先ブック[ " & DatBookName & " ]に名前[ " & DatRangName _
　　　　　　　　 & " ]の定義がありません"
　　　　GoTo ErrorHandler
　　End If
　　Err.Clear

　　'ダミーアクセスで作業用シートチェック
　　Dummy = ThisWorkbook.Sheets(sTempShName).Range("A1").Value
　　If Err.Number > 0 Then
　　　　'エラー発生なら作業用シート追加
　　　　Err.Clear
　　　　With ThisWorkbook.Sheets.Add(Before:=Sheet1)
　　　　　　.Name = sTempShName
　　　　End With
　　End If
　　On Error GoTo 0
　　Set SH = ThisWorkbook.Sheets(sTempShName)
　　SH.Visible = xlSheetVisible

　　'初期化
　　SH.Cells.Clear
　　lngR = 1

　　'参照先ブックのデータにリンク、、と思ったけど
　　'やはり値を転記させた方が良いかと。
　　For Each rngCel In rngDat
　　　　If Not IsEmpty(rngCel.Value) Then
　　　　　　'SH.Cells(lngR, 1).Formula = _
　　　　　　'　　"=[" & DatBookName & "]" & _
　　　　　　'　　rngCel.Parent.Name & "!" & rngCel.Address
　　　　　　SH.Cells(lngR, 1).Value = rngCel.Text
　　　　　　lngR = lngR + 1
　　　　End If
　　Next rngCel
　　
　　'リストをソート
　　SH.Columns("A:A").Sort Key1:=SH.Range("A1"), Order1:=xlAscending, Header:=xlGuess
　　'作業用シートをVeryHidden で隠す
　　'ユーザーに再表示させたくないなら xlVeryHidden で
　　SH.Visible = xlHidden
　　
　　'リンクされたセルのアドレス取得
　　sAddress = SH.Range(SH.Cells(1, 1), SH.Cells(lngR - 1, 1)).Address

　　'入力規則を設定するシートのA列に入力規則を設定
　　With ThisWorkbook.Sheets(sTargetName).Columns(1).Validation
　　　　.Delete
　　　　.Add Type:=xlValidateList, _
　　　　　　 Formula1:="=INDIRECT(""" & sTempShName & "!" & sAddress & """)"
　　　　.IgnoreBlank = True　　'空白値の入力を許可
　　　　.InCellDropdown = True 'ドロップダウンリスト表示
　　End With

Terminate:
　　Set rngCel = Nothing
　　Set rngDat = Nothing
　　Set SH = Nothing
　　On Error Resume Next
　　　　'参照先ブックを自動的に閉じないのであれば
　　　　'次行をコメントアウト
　　　　WB.Close
　　On Error GoTo 0
　　Set WB = Nothing
　　Exit Sub
ErrorHandler:
　　Application.ScreenUpdating = True
　　MsgBox strMes, vbCritical
　　GoTo Terminate
End Sub

No.4 回答者： imogasi 回答日時： 2005/09/25 10:59

#2です。

＃２の補足などについて。
値リストの値について、VBAでBook2の対象箇所を読んで、カンマで区切って、リスト
文字列を作ってFormula1にセットすれば、できますが、
（１）操作する人が、利用する場合に２０程度のアイテム数を超えると、スクロールが発生し、使い勝手が悪くなります。
（２）VBAは（イベントプロシージュアー式にしないと）そのプログラムを実行した時の状態で固定されてしまう。変更のつど実行も面倒。
まあエクセルを開いた都度更新（＃３のご回答？）ぐらいで我慢できるかどうかですが。
（３）（１）のことを考えると、リストに出す「アイテムを多段式に絞る」
（県名を指定すると、その県内だけの市区町村が出るような）ことが求められますが、これはエクセルでも、範囲を使った方法が２度ほど挙がっていますが複雑です。
この辺の問題の解決は、プロがSQLを使って、納入ソフトに組み入れる分野だと思う。少なくともアクセスVBAでやるのが、技巧に走らなくてできる
方向だと思います。

No.3 回答者： KenKen_SP 回答日時： 2005/09/25 02:21

こんにちは。

KenKen_SP です。

下記の VBA コードで一応ですが、実現できました。

しかし、コードのコメントにも書いておきましたが、入力規則のリストで
セル範囲を指定するのではなく、値指定できる長さには制限があるみたい
です。あまり長いリストは設定できません。

ですから、”一応”になってしまうのですが、、、

例外処理もいくつか含めておきましたので、参考にはなるかもしれません。

下記コードを標準モジュールにコピー＆ペーストして下さい。


Sub Auto_Open()

　　Call SetValidation

End Sub

Sub SetValidation()

　　Dim Buf　　　As Variant
　　Dim WB　　　 As Workbook
　　Dim aryDat() As String
　　Dim strDat　 As String
　　Dim strMes　 As String
　　Dim i　　　　As Long

　　Const DatBookName As String = "Book1.xls"
　　Const DatRangName As String = "データ"
　　　　
　　On Error Resume Next
　　'ダミーアクセスでブックの状態をチェック
　　Workbooks(DatBookName).Activate
　　If Err.Number > 0 Then
　　　　'エラー発生ならブックを開く
　　　　Err.Clear
　　　　Application.ScreenUpdating = False
　　　　Workbooks.Open Filename:=ThisWorkbook.Path & "\" & DatBookName
　　　　If Err.Number > 0 Then
　　　　　　strMes = "参照先ブック：" & DatBookName & "が見つかりません"
　　　　　　GoTo ErrorHandler
　　　　End If
　　End If
　　Err.Clear
　　
　　'名前「データ」の値を配列にバッファ
　　Set WB = Workbooks(DatBookName)
　　Buf = WB.Names("データ").RefersToRange.Value
　　If Err.Number > 0 Then
　　　　strMes = "名前：" & DatRangName & " が定義されてません"
　　　　GoTo ErrorHandler
　　End If
　　WB.Close
　　On Error GoTo 0
　　
　　'一次元配列に格納し直して、さらに文字列で連結（汗）
　　ReDim aryDat(UBound(Buf) - 1)
　　For i = 0 To UBound(Buf) - 1
　　　　aryDat(i) = Buf(i + 1, 1)
　　Next i
　　strDat = Join$(aryDat, ",")
　　
　　'シート1のA列に入力規則を設定
　　With ThisWorkbook.Sheets("Sheet1").Columns(1).Validation
　　　　.Delete
　　　　'次行でリストを設定するのですが、、
　　　　'配列を受け付けないので、カンマ区切りの文字列で設定しています。
　　　　'リストが大きすぎるとエラーになりますので注意。
　　　　.Add Type:=xlValidateList, Formula1:=strDat
　　　　.IgnoreBlank = True　　'空白値の入力を許可
　　　　.InCellDropdown = True 'ドロップダウンリスト表示
　　End With

Terminate:
　　Set WB = Nothing
　　Exit Sub
ErrorHandler:
　　Application.ScreenUpdating = True
　　MsgBox strMes, vbCritical
　　GoTo Terminate
End Sub

この回答への補足

KenKen_SP様；
おはようございます。ご丁寧なご回答をいただきありがとうございます。
やはりVBAを使わなければ無理ですか…。
今回，元の値となるデータは，13列分，1列あたり50～60種類，1リストは短くても10文字程度から最長で80文字程度の文字列です。このデータを100個ほどのExcelファイル（Book）で使いたく質問させていただきました。
またデータ（リスト）は頻繁に更新されます。
自分がやろうとしていることは，ExcelではなくAccessでやるべきことなのでしょうか！？

補足日時：2005/09/25 08:14

No.2 回答者： imogasi 回答日時： 2005/09/24 11:57

このニーズは

・別ブックのデータがあり、そのデータ範囲の増減を即時反映したい。
・当ブックへコピーするのが面倒
・他ブックのリストデータが行数が多い。
などのために、他ブックのデータを使いたいのでしょうか
最初のケースだと、更なる難題を抱え込む。
ーーー
入力規則のリストの許容状況を総括すると
・入力規則は他シートのセル範囲を番地では指定できない。
・ただし名前を定義して、名前を指定すればできる
・名前の定義はブックレベルの名前定義が標準で、シートレベルの名前定義もできる。
・ということは通常では、当ブックを超えた他ブックの名前を参照できない。
・あとは、他ブックのセルを、当ブック（別シート）にリンクさせて、当ブックに値が存在するかのようにして、そこに名前をつけて参照できるかどうかです。
適当例がすぐ作りにくいので、質問者でやってみてください。
・VBAで何かよい方法はないか考えると
Sub Macro3()
Range("A1:A11").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=範囲１"
End With
End Sub
の xlBetween, Formula1:="=範囲１"
の部分の指定で、ウルトラC技がないかどうかだが、なさそう。
（注、値指定の際はFormula1:="a,s,d,f"のようにする。）
ご参考になれば幸いです。

この回答への補足

imogasi様；
ご回答ありがとうございます。
今回の質問のニーズは貴殿がご指摘なさる「他ブックのリストデータが行数が多い」から…です。
行数もさることながら，ひとつのSheetに7～8列，それぞれ別のデータを参照しなければなりません。
また「そのデータ範囲の増減を即時反映したい」のも理由のひとつです。データを参照しつつも適宜新しいデータが発生しますので，データは増える一方です。

補足日時：2005/09/24 12:35

No.1 回答者： sassakun 回答日時： 2005/09/24 10:51

例えば，Book2 の

B列1～10行　に

=[Book1.xls]Sheet1!A1
=[Book1.xls]Sheet1!A2
=[Book1.xls]Sheet1!A3
=[Book1.xls]Sheet1!A4
=[Book1.xls]Sheet1!A5
=[Book1.xls]Sheet1!A6
=[Book1.xls]Sheet1!A7
=[Book1.xls]Sheet1!A8
=[Book1.xls]Sheet1!A9
=[Book1.xls]Sheet1!A10

と書いておいて，
Book2 のA列1行の入力規制のリストの元の範囲を

=$B$1:$B$10

とすれば，できることはできますが，入力規制自身の範囲に

=[Book1.xls]Sheet1!$A$1:[Book1.xls]Sheet1!$A$10

のように別のBookを指定するのはできないみたいです。