VBA コンボBOXでサーバー上の別ブックを参照

質問

皆さんこんにちは。
エクセル2013使用をしております。

現在Book1.xlsxのユーザーフォーム内にある
コンボBOX1にサーバー上に存在するデータベース.xlsxの
A3～A最終行を参照してコントロールにしようと
マクロを作成中です。

本やネットを参考に
”サーバー上に存在するデータベース.xlsxの『A3：A100』をコントロールにする”
まで作成したのですが
『A最終行』Range("a1048576").End(xlUp).Offset(1).Selectを
どのように記載すれば良いか分かりません。

サーバー上の別ブックを参照し
重複しないようコンボBOXのコントロールを作成したいのです。
ご教授いただけないでしょうか。

Private Sub UserForm_Initialize()
Dim myFormula As String
Dim rowCount As Long
Dim i As Long, j As Long
Dim Ar() As Variant

Const myPath As String = "'\\***.**.**.**\data\[データベース.xlsx]Sheet1'!$A$3:$A$100"

myFormula = Application.ConvertFormula(myPath, xlA1, xlR1C1, xlAbsolute)
rowCount = Application.ExecuteExcel4Macro("ROWS(" & myFormula & ")")
ReDim Ar(rowCount - 1)
For i = 1 To rowCount
Ar(j) = Application.ExecuteExcel4Macro("INDEX(" & myFormula & "," & i & ",0 )")
j = j + 1
Next
ComboBox1.List = Ar
End Sub

回答No.1

real beatin（@realbeatin） · ベストアンサー

こんにちは。

ExecuteExcel4Macroを使う方法で、一旦は解答書いてみたのですが、
最終行を取得する方法が難しくて、考えても解らなかったので、
代替え案で動く様には出来たものの、
結果的に記述が冗長（下に示すものより厚量）になり、
また、レコード数を増やすほど動作が重くなるようなので、
ExecuteExcel4Macro以外の他の方法を提案しようと考えることにしました。

> サーバー上の別ブックを参照し
> 重複しないようコンボBOXのコントロールを作成したいのです。

Win7 x64 / Excel2010 x64 で動作確認していますが、
今こちらは、スタンドアローンなので、
サーバー上のファイルでは試せていません。
もし、その点でうまくいかないようでしたら御容赦下さい。

「ブックを開かずにExcelテーブルを参照する方法」
　→ ADODB
「配列から重複を取り除く方法」
　→ Scripting.Dictionary
このふたつが主役になりますが、
比較的簡単に書ける、比較的処理が速い、一般によく知られている、
という理由で選んでいます。
これらのオブジェクトを使う為に、ＶＢＡで[参照設定]を追加する必要があります。
[参照設定]をしないと、コンパイルエラーになります。

単列（ひとつのフィールド）のデータのみ取得する形で書いています。
複数列を取得する場合は、書き加える必要があります。
例えば、
Const myRef = "A3:C65536"
のように３列で指定すると、そのままでも
　　mtx() = oRSet.GetRows
の結果は、正しく３列分のデータが採れますが、
その後の処理に工夫が必要になります。

重複の削除については、
　　oRSet.Open "SELECT DISTINCT * FROM [" ...
のように、SQLにちょこっと付け足すだけでも出来るのですが、
勝手にソートされちゃうのを避ける方法が見つからないので、
Dictionary オブジェクトを使う方法ことにました。
勝手に並べ替えされても構わないなら、もう少し簡単にできる、という、、、。

myPath に指定するのは、ブックのフルパスです。
クォートや角括弧を含めずに、普通に書いて指定して下さい。

以下が私の提案するスクリプトです。

' ' ///

' ' ■(ADODB)参照設定■Microsoft ActiveX Data Objects x.x Library■ ... x.x=6.1? 最新版で
' ' ■(Scripting)参照設定■Microsoft Scripting Runtime■

Private Sub UserForm_Initialize()

Const myPath = "\\***.**.**.**\data\データベース.xlsx"　'　　要指定◆ブックへのパス
Const mySheet = "Sheet1"　'　要指定◆シート名
Const myRef = "A3:A65536"　'　要指定◆セル範囲／最下行は余分に指定しても処理に影響しない
Const myProv = "Microsoft.ACE.OLEDB.12.0"　'　固定▼
'Const myProv = "Microsoft.Jet.OLEDB.4.0"　'　固定▲環境によっては、上の行と差し替え

　　' ' データソース（Excelブック）へのコネクション生成
Dim oConn As New ADODB.Connection
　　oConn.Open "Provider=" & myProv & _
　　　　　　　　";Data Source=" & myPath & _
　　　　　　　　";Extended Properties=""Excel 12.0;HDR=No;ReadOnly=True"""

　　' ' レコードセット 取得 [Sheet1$A3:A65536]
Dim oRSet As New ADODB.Recordset
　　oRSet.Open "SELECT * FROM [" & mySheet & "$" & myRef & "]", _
　　　　　　　　oConn, adOpenStatic, adLockOptimistic, adCmdText

　　' ' レコード数 を取得
Dim rowCount As Long
　　rowCount = oRSet.RecordCount　'　方法を示す為だけの記述なので 未使用です

　　' ' レコードセットすべて を 配列変数 に格納
Dim mtx()
　　mtx() = oRSet.GetRows　'　←　行列反転した配列

　　oRSet.Close: Set oRSet = Nothing: oConn.Close: Set oConn = Nothing　'　ADODB オブジェクト の後始末

　　' ' 重複削除　Dictionary オブジェクト
Dim oDict As New Scripting.Dictionary
Dim v
　　' ' Dictionary オブジェクトに 重複しないキー を格納
　　For Each v In mtx()
　　　　oDict(v) = Empty
　　Next
　　Erase mtx()　'　配列変数初期化

　　' ' コンボボックスの.List に Dictionary オブジェクトのキー配列 を渡す
　　ComboBox1.List = oDict.Keys()

　　oDict.RemoveAll: Set oDict = Nothing　'　Dictionary オブジェクトの後始末
End Sub

' ' ///

お礼

realbeatinさん
夜遅くまで考えていただいたようで
ありがたいやら申し訳ないやら・・・感謝の気持ちでいっぱいです。
ExecuteExcel4Macroにあとちょっと足したら
やりたい事が出来るんじゃないか？という私の浅はかな考えで
ご面倒をおかけした事お詫びいたします。
力技でデータベースをアクディブBookにコピペしてそれを参照した方が
簡単だったのかな、
最初から初心者が欲張り過ぎたかなと
猛烈に反省しております。
まさかこんな全然予想と違う形の回答をいただくとは・・・

realbeatinさんのご回答で希望の動作が出来ました。
度重なるご回答、本当にありがとうございます。