dポイントプレゼントキャンペーン実施中!

こんばんは
既出の質問かもしれませんが探し出せず、
また、VBA勉強中の初心者ですが質問させていただきます。

今データベースの検索マクロを組んでいます。

検索ブックとデータベースブックに分けており
検索対象としてその別ブックのデータベースの複数シート(図1)から参照し
検索ブックの「検索結果シート」に抽出したいです
(検索条件は検索シートの項目入力です(図2))

データベースブックのシート数は更新によって都度変わります。


For~next でできるとは思うのですが
うまく組めません。

フィルタオプションとマクロの記録を使い
特定シートの参照はできるのですが…

Sheets("検索結果").Select
Workbooks("全データベース.xlsm").Sheets("2013").Range("A3:X10000").AdvancedFilter _
Action:=xlFilterCopy, CriteriaRange:=Range("検索!Criteria"), CopyToRange:= _
Range("A3:V3"), Unique:=False

記録そのままのマクロですが
上記にFor~nextを組み込めばいいのか、他の式が良いのか…
あと、データブックシートは常に開いているわけでないので
openメソッドも必要かと思うのですが…

知識不足で恐縮ですが
どなたかご教授願えますか?

「エクセルVBA 別ブックの複数シートの参」の質問画像

A 回答 (3件)

こんにちは


基本的にはNo1様のご回答に同感ですが、何らかの経緯やご質問の様にしなければならない事情などがあるのかも。

>For~next でできるとは思うのですが
>うまく組めません。
の部分と
>あと、データブックシートは常に開いているわけでないので
>openメソッドも必要かと思うのですが…
の部分に関するところをごく簡単なサンプルにしてみました。

>特定シートの参照はできるのですが…
とのことなので、各シート毎の実際の処理は質問者様におまかせです。

1)特定のブック(データベースブック)が開いているかチェックし
 開いていなければ、新たに開く
2)ブック内の全てのシートに対してループで処理を行う
 シート数は可変(非固定)です
 (それぞれのシートでの処理内容は質問者様にお任せ)
というものです。
とりあえずは、動作チェックも兼ねて各シート名を列挙するようにしてあります。

Sub Sample()
 Dim wb As Workbook, flg As Boolean
 Dim sh As Worksheet, shOrg As Worksheet

 Const dataWB = "DataBook.xlsm" '←データベースブックの名称
 Const dataPath = "C:\hoge\data\" '←データベースブックへのパス

'現在のシートを記憶しておく
 Set shOrg = ActiveSheet

'データベースブックが開いているかをチェック
 flg = True
 For Each wb In Workbooks
  If wb.Name = dataWB Then
   flg = False
   Exit For
  End If
 Next wb

'ブックが開いていなければ新たに開く
 If flg Then Workbooks.Open Filename:=dataPath & dataWB
 Set wb = Workbooks(dataWB)

'データベースブック内の全シートを対象にループする
 For Each sh In wb.Worksheets
  'shに各シートオブジェクトが取得された状態でループするので
  'このループ内で必要な処理を行ってください
  '
  'とりあえずは動作確認もかねて、各シート名をA列に追記
  '
  shOrg.Cells(shOrg.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Value = sh.Name
 Next sh

'終了処理。ブックを新たに開いた場合は閉じる
 If flg Then wb.Close SaveChanges:=False
 Set wb = Nothing

End Sub
    • good
    • 1
この回答へのお礼

>>fujilin様
ありがとうございます!><私も頼まれている側なので困ってしまって…
コードも細かく書いていただきありがとうございます。
openも私のコードは大雑把なので助かります。

再度考えつつ、参考にさせていただきます!

お礼日時:2016/04/01 21:22

re.re.さんの都合でデータベースブックを考えたのだと思っていました。

事情を知らず申し訳ありません。
そこで、データベースブック内のすべてのシートをひとつのテンポラリシートにまとめるマクロを書いてみました。
テンポラリシートを元に、re.re.さんの書いたAdvancedFilter メソッドを実行すれば実現可能と思います。

Sub sample()
Dim wbDB As Workbook
Dim wsDB As Worksheet
Dim ws As Worksheet 'テンポラリシート
Set wbDB = Workbooks.Open("C:\hoge\data\DataBook.xlsm", , True)
For Each wsDB In wbDB.Worksheets
If ws Is Nothing Then
'最初のシートの場合は、そのままコピーして新規ブックを作成。
wsDB.Copy
Set ws = ActiveSheet
Else
'2番目以降のシートの場合は、2行以降をコピーして追加。※見出し行数に応じて要調整!!
wsDB.Rows("2:" & wsDB.Cells(Rows.Count, 1).End(xlUp).Row).Copy
ws.Rows(ws.Cells(Rows.Count, 1).End(xlUp).Row).PasteSpecial
End If
Next
Application.DisplayAlerts = False
wbDB.Close
Application.DisplayAlerts = True

'ここから先は、re.re.さんが書いたコードです。
Sheets("検索結果").Select
ws.Range("A3:X10000").AdvancedFilter _
Action:=xlFilterCopy, CriteriaRange:=Range("検索!Criteria"), CopyToRange:= _
Range("A3:V3"), Unique:=False
End Sub
    • good
    • 0
この回答へのお礼

>>ママチャリ様
こちらの説明不足なのでとんでもございません!こちらこそ気を遣わせてしまいまして申し訳ないです><
そしてデータまで書いてくださりありがとうございます!本当に助かります!
参考に(大部分をですが笑)させていただきます!

お礼日時:2016/04/03 01:09

「検索ブックとデータベースブックに分けており」…ここまでは良いでしょう。


「データベースの複数シート」って、NGですよ。
せっかく、データベースブックを作ったのなら、同じデータはひとつのシートに統合してください。そうすれば、こんな質問をしなくて済みます。
もし、1シートで入りきらない程のデータを処理するのであれば、Access等のDBを検討して下さい。

ちなみに、AdvancedFilterメソッドでは、1シート目の抽出はできても、2シート目の抽出結果を追加することができないと思います。結局は、全シートをひとつのテンポラリシートに纏める。もしくは、1シートづつマクロで、ちまちま抽出することになると思います。
    • good
    • 0
この回答へのお礼

>>ママチャリ様
お礼が遅れてすみません。
やはり無駄処理ですか…。シートに統合したら確かに解決ではあるんですが。。。
もう少し考えます、ご指摘ありがとうございました(´人`)

お礼日時:2016/04/01 21:16

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています