複数シートからの抽出

お世話になっております。

エクセル初心者です。簡単な関数は理解しておりますが、マクロはネットでコピペして加工して使っている程度です。

画像はサンプルです。
シートは50以上あります。
検索用の別シートを作り、検索用シートのA1に現場名を入力し、B1に本支店名を入力し、A2以降に検索結果を抽出し表示したいのです。抽出されるのは、現場名・本支店名・距離のみに限定したいです。
複数シートからの抽出と複数条件ということは可能でしょうか？

そのあとはダブルクリックイベントで距離を利用しようと思っているのですが、そちらは自力でできそうです。

皆様からご教示頂きたく存じます。
宜しくお願い致します。

No.3 回答者： mitarashi 回答日時： 2014/09/15 10:38

#2です。

質問者様はお気に召さない様ですが、バグが解消されたxl2007以降対応バージョンは結構使えるのではと最近思っております。「使えね～」と思われないためにちょっと補足します。

#2のSQLの抽出条件はデータ型が文字列型である事を前提としています。
データ型が数値型の場合は、シングルクォーテーションは不要とか、日付型の場合は#で挟むといった決まりがあります。
#2のMSのページにありますが、Excelブックに接続する際に、このデータ型の自動判定で問題が出る事があります。
（例：文字列の中に数値っぽいものが混在している場合、数値と判定されると文字列はnullになって失われる）
この様な場合、Extended PropertiesにIMEX=1を設定すると、全て文字列型と判定され紛れが少ないとされています。試してみると文字列型と数値型、文字列型と日付型が混在している場合は文字列型が優先されますが、数値だけの場合はやっぱり数値型になってしまう様でした。（MSの記事に最初の8行を読んで判別するとありましたので、8行でテストしています。）
With cn
.Provider = "Microsoft.ace.OLEDB.12.0"
.ConnectionString = "Data Source=" & ThisWorkbook.FullName & ";" & _
"Extended Properties='Excel 12.0; HDR=Yes; IMEX=1'"
.Open
End With
判定されたデータの型はrs.Fields(?).Typeで取得できますので、期待した型かどうかコード中で判定可能です。（文字列　202、数値　5、日付　7等）
なお、最初の1行で判定するというMaxScanRows=1は相変わらず無効な様でした。

詳しいサイトをみつけました。当方にとって、新しい知見がありました。ご参考まで。
http://antonsan.net/study/excel/excel019.php

No.2 回答者： mitarashi 回答日時： 2014/09/11 00:11

画像が読み取れないので、簡単なモデルでやってみました。

xl2003以前は自ブックに対する適用に問題があったそうですが、xl2010の様に見えるのでADOでやってみました。
若干のSQLの知識が必要ですが、初めの一歩のレベルですので、眺めればご理解いただけると存じます。

Sub test()
Dim cn As Object, rs As Object
Dim mySQL As String, tableAddress As String
Dim i As Long
Dim srcSheet As Worksheet, destSheet As Worksheet
Dim nextOutputCell As Range

Const adUseclient As Long = 3

On Error GoTo errHandle
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
rs.CursorLocation = adUseclient
With cn
.Provider = "Microsoft.ace.OLEDB.12.0"
.ConnectionString = "Data Source=" & ThisWorkbook.FullName & ";" & _
"Extended Properties='Excel 12.0; HDR=Yes'"
.Open
End With
Set destSheet = ThisWorkbook.Sheets("Sheet1")
'検索範囲を空白行も含めて大きめに設定、実際に合わせてアレンジが必要
tableAddress = "A2:C1000"

'最初のシート以外を全て検索対象とする。
'対象シートには少なくともA2:C2に見出しが設定されていないとエラー-21472179041になる
For i = 2 To ThisWorkbook.Worksheets.Count
Set srcSheet = ThisWorkbook.Sheets(i)
mySQL = "select 現場名,本支店名,距離 from [" & srcSheet.Name & "$" & tableAddress & "] where 現場名='fieldName' AND 本支店名='branchName';"
mySQL = Replace(mySQL, "fieldName", destSheet.Range("A1"))
mySQL = Replace(mySQL, "branchName", destSheet.Range("B1"))
rs.Open mySQL, cn
If rs.RecordCount > 0 Then
With destSheet
Set nextOutputCell = .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0)
End With
nextOutputCell.CopyFromRecordset rs
End If
rs.Close
Next i
errHandle:
If Err.Number <> 0 Then
Debug.Print Err.Number & Err.Description
End If
If Not rs Is Nothing Then
If rs.State = 1 Then rs.Close
Set rs = Nothing
End If
If Not cn Is Nothing Then
If cn.State = 1 Then cn.Close
Set cn = Nothing
End If
End Sub

参考
http://home.att.ne.jp/zeta/gen/excel/c04p01.htm
http://support.microsoft.com/kb/257819/ja

No.1 回答者： shintaro-2 回答日時： 2014/09/10 19:56

>複数シートからの抽出と複数条件ということは可能でしょうか？

可能ですが、
あくまでも一つの抽出条件は一つのシートからです。

こちら↓が参考になるでしょう。
http://pc.nikkeibp.co.jp/pc21/tech/excel36/

この回答へのお礼

ありがとうございます。

一つのシートからの部分一致の複数条件の検索はfindとindexを使って作ることができました。

なので、マクロを使えば複数シートでできないかと思ったのですが、やはり難しいみたいですね…

お礼日時：2014/09/10 22:43