AccessのデータをExcelに抽出

0
件


.

Access2000のデータからExcel2013にデータを抽出する方法を教えて下さい。

C:\JRA\Accessに
「2014.mdb」と「出馬表当日.xls」が保存されています。
　　　　　　　　　　　↓
　　　　　　　SheetDBのC列、D列、E列、F列を抽出項目とします。

「出馬表当日.xls」のSheetDBのC列に騎手名、D列には0か1、E列には4桁の数字、F列には漢字2文字が並んでいます。これを抽出項目にしたいのです。

行番号,C列,D列,E列、F列
↓, ↓, ↓, ↓　　　　　　　　　　　　　　　　　　　　　　　　　　　　　
01柴山雄一,1,1200,東京
02伊藤工真,1,1200,東京
03松岡正海,1,1200,東京
04黛弘人,1,1200,東京
05
06吉田豊,0,1800,阪神
07北村宏司,0,1800,阪神
08浜中俊,0,1800,阪神
09
10大野拓弥,0,2200,京都
11赤岡修次,0,2200,京都
12岩田康誠,0,2200,京都
13
14石川裕紀人,1,2000,小倉
・・・・・・・・・

上の場合、01～04の条件でAccess2000のデータから抽出したものをひとつのシート（1R）に、06～08の条件で抽出したものを別のシートに(2R)、.....と空白行ごとに抽出して、その結果を「出馬表当日.xls」にシートを変えて貼り付けたいのです。
空白行から空白行までは最大18名分入っています。
名前とD列(0か1)、E列(4桁の数字)の数字、F列（漢字2文字）をAccessの抽出項目とします（Access2000のフィールドは13あってその6番目に名前、3番目に「0か1」5番目に「4桁の数字」13番目に「漢字2文字」が入っています）。
この（最大）18名の名前と2種類の数字をAccessの抽出項目として、Excel2013に抽出したいのです。
以前、名前のみでの抽出を教えていただいたのですが、2種類の数字を条件として追加すべく頑張りましたが、さっぱり分からず、再度投稿させていただきました。
http://oshiete.goo.ne.jp/qa/8838454.html
よろしくお願いします。

No.1 ベストアンサー 回答者： 30246kiku 回答日時： 2015/02/12 19:58

あれ？ 教えて!goo って変わったんですね？

QA 全部見たいので、bekkoame の方で閲覧していました。
広告表示もないし･･･　10 件以上が１度に見れるし･･･
最近、回答行為は、チョッと違うかな？っていう方がおられたので控える事に･･･

久々に 教えて!goo から見ると、質問の項目がいろいろ違うみたいで･･･


SQL 部分を変更してみました。（CSQL /　sSql 操作部分）
他部分は、ほぼ前のままです。

今回のSQLでは、Excelシート SheetDB を直接参照します（AS Q2 として）
C ～ F 列を、F1 ～ F4 として参照できます。
この方法は、前回ご質問での ＃２ の回答を発展させたものになります。
前回同様、エラーとかになったらスルーしてください。

下記 ★6、★3、★5、★13、部分をテーブル 2014 にあるフィールド名に変更して試してみてください。


Public Sub Samp3()
　　Dim cn As Object, rs As Object
　　Dim sSql As String, sS As String
　　Dim v As Variant
　　Dim iRow As Long, iRowN As Long, iR As Long
　　Dim i As Integer
　　Const adStateOpen = 1
　　Const PN2007 As String = "Microsoft.ACE.OLEDB.12.0"
　　Const PN2003 As String = "Microsoft.Jet.OLEDB.4.0"
　　Const CMDB As String = "\2014.mdb"
　　Const CSQL = "SELECT Q1.* FROM 2014 AS Q1 INNER JOIN " _
　　　　　　& "(SELECT * FROM [SheetDB${%1}] IN '{%2}'[Excel 8.0;HDR=NO]) AS Q2 " _
　　　　　　& "ON Q1.★6=Q2.F1 AND Q1.★3=Q2.F2 AND Q1.★5=Q2.F3 AND Q1.★13=Q2.F4;"

　　On Error Resume Next
　　Set cn = CreateObject("ADODB.Connection")
　　For Each v In Array(PN2007, PN2003)
　　　　cn.Open "Provider=" & v _
　　　　　　& ";Data Source=" & ThisWorkbook.Path & CMDB
　　　　If (cn.State = adStateOpen) Then Exit For
　　Next
　　If (IsEmpty(v)) Then
　　　　MsgBox "環境不足で処理中断", vbCritical
　　　　Set cn = Nothing
　　　　Exit Sub
　　End If
　　On Error GoTo 0

　　Application.ScreenUpdating = False
　　With Worksheets("SheetDB")
　　　　iR = 1
　　　　iRow = 1
　　　　While (.Cells(iRow, "C") <> "")
　　　　　　sSql = Replace(CSQL, "{%2}", ThisWorkbook.FullName)
　　　　　　iRowN = iRow
　　　　　　With .Cells(iRow, "C")
　　　　　　　　If (.Offset(1) <> "") Then iRowN = .End(xlDown).Row
　　　　　　　　sSql = Replace(sSql, "{%1}" _
　　　　　　　　　　, .Resize(iRowN - iRow + 1, 4).Address(False, False))
　　　　　　End With

　　　　　　sS = iR & "R"
　　　　　　For Each v In Worksheets
　　　　　　　　If (v.Name = sS) Then Exit For
　　　　　　Next
　　　　　　If (IsEmpty(v)) Then
　　　　　　　　With Worksheets.Add(After:=Worksheets(Worksheets.Count))
　　　　　　　　　　.Name = sS
　　　　　　　　End With
　　　　　　Else
　　　　　　　　v.Activate
　　　　　　　　Cells.ClearContents
　　　　　　End If

　　　　　　Set rs = cn.Execute(sSql)
　　　　　　If (Not rs.EOF) Then
　　　　　　　　With Range("A1")
　　　　　　　　　　For i = 0 To rs.Fields.Count - 1
　　　　　　　　　　　　.Offset(, i) = rs(i).Name
　　　　　　　　　　Next
　　　　　　　　　　.Offset(1).CopyFromRecordset rs
　　　　　　　　End With
　　　　　　End If
　　　　　　Columns.AutoFit ' 列幅を調整してみた
　　　　　　rs.Close
　　　　　　Set rs = Nothing
　　　　　　iRow = iRowN + 2
　　　　　　iR = iR + 1
　　　　Wend
　　　　.Activate
　　End With
　　cn.Close
　　Set cn = Nothing
　　Application.ScreenUpdating = True
End Sub

この回答へのお礼

早速の御回答ありがとうございます。
一発でできました。「凄い！」の一言です。
gooは最近変わったようです。使い辛くなりました。
もう一点甘えてもいいですか。
追加された各シートの1行目を「先頭行の固定」＋「フィルタ設定」するにはどうすればよいか教えていただけないでしょうか。
よろしくお願い致します。

お礼日時：2015/02/13 00:06

No.2 回答者： 30246kiku 回答日時： 2015/02/13 05:00

＃１です

動きましたか･･･
じゃぁ、前回エラーだったのはシート名が違っていたりしたんでしょうかね。

> 追加された各シートの1行目を「先頭行の固定」＋「フィルタ設定」するにはどうすればよいか教えていただけないでしょうか。

これ、ご自分で操作できるのであれば、「マクロの記録」を使ってみるのも良いかも。
「先頭行の固定」＋「フィルタ設定」を 2007 でやってみると、以下が記述されます。

Sub Macro1()
'
' Macro1 Macro
'

'
　　With ActiveWindow
　　　　.SplitColumn = 0
　　　　.SplitRow = 1
　　End With
　　ActiveWindow.FreezePanes = True
　　Selection.AutoFilter
End Sub

この記述されたものを、違うシートでステップ実行してみます。
すると、ウィンドウを分割してから枠を固定している事がわかります。
この動きで良ければ、このままの記述を組み込んでいけば良いです。
私が知っている枠固定の方法は別にあって、

　　Range("B2").Activate
　　ActiveWindow.FreezePanes = True

とすると、アクティブセルの上側・左側を固定するというもの。
上記は、B2 を指定しているので、１行目と A 列が固定に･･･
今回は１行目だけなので、左側が無い A2 を指定すれば･･･良いですね

で、Samp3 に組み込んでいきますが、フィルタの設定
　　Selection.AutoFilter
は、それなりに項目が記述されていないとエラーになるみたいなので、抽出したものを転記した後

　　　　　　　　End With
　　　　　　　　Range("A2").Activate ' ★
　　　　　　　　ActiveWindow.FreezePanes = True ' ★
　　　　　　　　Selection.AutoFilter ' ★
　　　　　　End If
　　　　　　Columns.AutoFit ' 列幅を調整してみた

これで、終了･･･でも良いですが、
現状、抽出を繰り返す＝シートの使い回し　になっています。
前回、何件か抽出されていて、今回０件ならシートは空白になりますが、枠固定が残ってしまう事に･･･

　　　　　　Else
　　　　　　　　v.Activate
　　　　　　　　Cells.ClearContents
　　　　　　　　ActiveWindow.FreezePanes = False ' ★
　　　　　　End If

上記部分で、枠固定を解除する様にしといた方が良いかも。
オートフィルタは、Cells.ClearContents　することで解除されるみたい･･･？


※
> もう一点甘えてもいいですか。

動いた･･･とかの後に、追加質問があった場合、
おそらく他の方は回答してこないと思うので、急を要する場合などは別質問にした方が良いかも？
しかも、内容的には Excel のカテゴリになる？
Excel に関しての回答者さんは、Access より多いかな？

私のわかる範囲で追加等には応えていこうとは思っていますけど･･･
自分でやったのと、聞いただけのものなら、後々自分でやった方を覚えている？のかな？

この回答へのお礼

いろいろとありがとうございました。
追加質問にまでお答えいただき感謝に堪えません。
早朝にもかかわらず、ありがとうございました。
30246kiku さんが見てくれれば一発なのになぁと思っていたら、本当に見ていただけるとは。
無事、解決しました。
まだまだインフルエンザが猛威を振るっているそうですので、お体にはお気を付け下さい。
本当にありがとうございました。

お礼日時：2015/02/13 07:29