Excelのマクロについてです。全く手がつけられないのでお知恵を拝借願えませんでしょうか。
あるシートに記載された検索キーをもとに複数ブックを検索し、そのデータを含むシートを拾い出すという作業を考えています。
あるレコード(数は10~50程度)に格納された文字列を複数ブックにわたって完全一致検索し、その文字列が含まれるシートを逐一拾ってくる(コピーしてくる)というマクロを考えています。
<状態>
レコードが入ったシート"C:\サンプル住所.xls"の内容:
シートは一枚(シート名:検索元)
セルD5 東京都港区
セルD6 青森県青森市
セルD7 東京都港区
セルD8 北海道足寄町
セルD9 福岡県北九州市
レコードはすべて文字列です。この例では5つですが、レコード数は1~多くても50くらいの間で変動し、同じ文字列が複数回出現することもあります。セル結合はありません。
検索先であるデータベース(以下"DB")は下位ディレクトリ(Prefフォルダ)に各都道府県のブックを放り込んであります:
C:\Prefs\北海道.xls
C:\Prefs\青森.xls
C:\Prefs\宮城.xls
(以下続く)
これら各ブックはシート1枚のみの構成で、セル結合はありません。またデータの重複はありません。なおブックの総数は47都道府県分とは限らず、検索内容によって変動します。
<目標>
"DB"内に"東京都港区"が存在するかどうかを検索し、見つかったら"C:\サンプル住所.xls"の最後に該当シートを追加。見つからなかった場合は空白シートを追加。どちらの場合もシート名は連番&検索キーとします。
これをレコードの数だけループさせ、検索されたシートがぎっしり詰まったブックを完成させます。
つまり、完成後のシートは左から以下のように並びます。
検索元 > 1_東京都港区 > 2_青森県青森市 > 3_東京都港区 > 4_北海道足寄町 > 2_大阪府大阪市
検索の導入部分としてダイアログを出しDBのディレクトリを選ぶところや、シート名をつけなおすあたりはさすがに何とかなるのですが・・・
ワークシート関数でしたらそれなりに使えるのですが、ブックをまたいだ作業はどこから手をつければいいのか皆目わからず。
ポインタやヒント、サンプル等、ご教示頂けると大変助かります。
自分でどこまで組み立てたのか?の思考の過程すら提示できずお恥ずかしい限りですが、なにとぞよろしくお願いします。
No.3ベストアンサー
- 回答日時:
あらかじめファイルリストを作成するサンプルです。
#2さんの書き込みを見て気づいたんですが、1レコード検索する毎に
全エクセルファイルをオープン、クローズしているので
実行速度が遅いかもしれません。
Option Base 0
Option Explicit
Sub test()
Dim i As Long
Dim j As Long
Dim SearchWord As String
Dim FileList() As String
Dim FileCnt As Long
Dim ws As Worksheet
Set ws = ActiveSheet
Application.ScreenUpdating = False
'ディレクトリ指定でエクセルファイルのリストを作成する
FileCnt = GetAllxlsFilesInDir("D:", FileList())
For i = 1 To Range("D65536").End(xlUp).Row
ws.Activate
SearchWord = Range("D" & i)
If SearchWord = "" Then
GoTo NEXT_RECORD
End If
'毎回Openを繰り返しているので遅いかも・・・
For j = 0 To FileCnt - 1
Workbooks.Open(FileList(j)).Activate
'レコードの検索
If (Cells.Find(What:=SearchWord, after:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False) Is Nothing = False) Then
'見つかったらシートのコピー&リネーム
With ThisWorkbook
ActiveSheet.Copy after:=.Sheets(.Sheets.Count)
.Sheets(.Sheets.Count).Name = i & "_" & SearchWord
End With
'閉じて次のレコードを探す
Workbooks(Dir(FileList(j))).Close savechanges:=False
GoTo NEXT_RECORD
End If
Workbooks(Dir(FileList(j))).Close savechanges:=False
Next j
'見つからなかったら空白のシートを追加
With ThisWorkbook
.Activate
Sheets.Add
ActiveSheet.Move after:=.Sheets(.Sheets.Count)
.Sheets(.Sheets.Count).Name = i & "_" & SearchWord
End With
NEXT_RECORD:
Next i
ws.Activate
Application.ScreenUpdating = True
Erase FileList
Set ws = Nothing
End Sub
'フォルダ内のエクセルファイルのファイルリスト作成
'引数1:検索フォルダパス 引数2:ファイルリスト
'戻り値:見つかったファイル数
Function GetAllxlsFilesInDir(ByVal strDirPath As String, ByRef xlsFiles() As String) As Long
Dim strTempName As String
Dim FileCnt As Long
On Error GoTo GetAllFiles_End
FileCnt = 0
' strDirPath が "\" 文字で終わっていることを確認します。
If Right$(strDirPath, 1) <> "\" Then
strDirPath = strDirPath & "\"
End If
' strDirPath がディレクトリであることを確認します。
If GetAttr(strDirPath) And vbDirectory <> vbDirectory Then
GoTo GetAllFiles_End
End If
'エクセルファイルを検索する
strTempName = Dir(strDirPath & "*.xls")
Do Until Len(strTempName) = 0
' "." と ".." を除外
If (strTempName = ".") Or (strTempName = "..") Then
GoTo NEXT_DIR
End If
If strTempName Like "*.xls" Then
'サブフォルダリストに登録する
FileCnt = FileCnt + 1
ReDim Preserve xlsFiles(FileCnt)
xlsFiles(FileCnt - 1) = strDirPath & strTempName
End If
NEXT_DIR:
' Dir 関数を使用して、次のファイル名を検索します。
strTempName = Dir()
Loop
GetAllFiles_End:
GetAllxlsFilesInDir = FileCnt
End Function
ありがとうございます。
原理はこれから勉強するところですが、ピンポイントで問題が解決できましたのでたいへん助かりました。
最初に回答を頂いた方の手順も美しいですが、こちらはいかにも動かしているといった感じでわかりやすいです。実行速度も特に気になりません。
大変勉強になりました。ありがとうございます。
No.4
- 回答日時:
>複数ブックを検索し、
(1)
そのブックは1つのフォルダの下に有るのか。それなら
Googleで「フォルダ ファイル VBA」でWEB照会のこと。(先ほどもこの質問があった。)WEBに記事がいっぱいある。
DIR利用
FSO利用(FSOの意味は、Googleで照会のこと)
の2方式の解説がある。
(2)シート
1つのブック名を捉えたとき、全シート名を捉えるのは
Sub test01()
Set wb = Workbooks.Open("01化.xls")
For Each sh In wb.Worksheets
MsgBox sh.Name
Next
End Sub
のように簡単なコードで捉えられる。
(3)
しかしエクセルの操作で、検索・置換はブック全体(全シート、検索場所=ブック)を対象にできるようになっているから、それを使えば、全シートを個々に捕まえる必要ない。
(4)マクロの記録をとって、勉強すること
(3)の操作をしてマクロの記録をとり、検索のコードがどのようになり、本質問のためには、どこを変えるべきか勉強のこと。マクロの記録を利用する事が質問に出ていないのはおかしい。
(5)問題はブックを開かずに処理が出来るかどうか。
Visible=Falseで画面に出さない程度で処理が速くできるのか
(先日も質問のあったが)エクセル4.0マクロで開かずに読んで処理できるのか、実際やってみないとわからない。
普通には質問者は、VBAの熟練者で無いようだから、ブックをOpenしー>処理しーー>Closeするの繰り返しで我慢してもらいたい。
エクセルはデータを別ブックに分けると処理がしづらい。この報いは必ず後でやってくる。表計算が多シートになったのもここ15年ぐらいだ。ファイルが別だと別世界。それを関連付けて扱うVBAの技量は上級者の者と思う。当面は無理しすぎの課題と思う。
は。すみません。背伸びどころではない内容です。
しかしこうして手順や原理から教えて頂けるのは大変有り難く思います。
すぐに答えが出なくても、この積み重ねでいずれは皆さんに回答者としてフィードバックできるよう、精進して参ります。
マクロの記録でいろいろいじってみたのですが、本文に書くと無駄に長くなってしまったのでばっさり切ってしまいました。手抜きのようで申し訳ありません。
ありがとうございました。
No.2
- 回答日時:
#1です。
レコード毎にファイルを開く・閉じるも大変そうなので、一旦新規Bookを作成し、
そこに集めたシートを検索対象としてます。
Sub try()
Dim wb_main As Workbook
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws As Worksheet
Dim r As Range, rm As Range
Dim ch As Boolean
Dim Fname As String
Application.ScreenUpdating = False
Set wb_main = ThisWorkbook
' 一旦各ファイルのシート(1)を新規Bookに集める
Set wb1 = Workbooks.Add
Fname = Dir("C:\Prefs\*.xls")
Do Until Fname = ""
Set wb2 = Workbooks.Open("C:\Prefs\" & Fname)
wb2.Worksheets(1).Copy After:=wb1.Worksheets(wb1.Worksheets.Count)
ActiveSheet.Name = Replace(Fname, ".xls", "")
wb2.Close False
Fname = Dir()
Loop
' --------------------------------------------------
With wb_main.Worksheets("検索元")
Set rm = .Range(.Range("D5"), .Cells(Rows.Count, 4).End(xlUp))
End With
For Each r In rm
ch = False
For Each ws In wb1.Worksheets
If Application.CountIf(ws.Cells, r.Value) > 0 Then
ws.Copy After:=wb_main.Worksheets(wb_main.Worksheets.Count)
ActiveSheet.Name = wb_main.Worksheets.Count & "_" & ws.Name
ch = True
End If
Next
If ch = False Then Worksheets.Add After:=wb_main.Worksheets(wb_main.Worksheets.Count)
Next
Application.DisplayAlerts = False
wb1.Close
Application.DisplayAlerts = True
Set wb_main = Nothing
Set wb1 = Nothing
Set wb2 = Nothing
Application.ScreenUpdating = True
End Sub
意図が違ったらごめんなさい。
ありがとうございます。先にシートを拾ってしまうとさすがに動作が速いですね。
今回はこの方法は採用しませんでしたが、他に使いたい場所があるので活用させてください。
大変参考になりました。ありがとうございます。
No.1
- 回答日時:
この例題の場合、
>セルD8 北海道足寄町
の検索対象ブックは
>C:\Prefs\北海道.xls
のみとなりそうですが違うのでしょうか?
「北海道足寄町」等のデータで『都道府県名』を基にすれば、複数ブックを
検索していく必要はないように思いますけど。
もし”例”としてあげているだけならば、スル~して下さい。
この回答への補足
ご指摘いただきありがとうございます。
検索キーや対象ブック名はあくまで例でして、キーの先頭数文字で対象となるブックを類推できるものではありません。
シート名はバラバラで、やはり前提どおり全てのブックを検索する必要があります。
あぁ、ボロの出ない例を考えていたのに・・・
何卒宜しくお願いします。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) VBA 検索と入力 Excel ブック ぶぶぶ シート ししし 列V 検索対象の列です 最終行は、お 6 2023/05/17 01:40
- Excel(エクセル) エクセルの複数ブックのシートを1つまとめたい 都道府県ごとに47ブックがあり、そのシートのデータを1 5 2022/11/15 14:57
- Visual Basic(VBA) マクロVBA 1シートをまとめる 閉じ方 初心者 SOS! 1 2022/06/17 14:54
- Visual Basic(VBA) EXCEL VBA 単語置き換え について質問です ブック名 ぶぶぶ シート名 ししし セル V3〜 3 2023/03/08 01:41
- Visual Basic(VBA) 顧客ごとに違う点検案内を作成するマクロ 4 2022/09/16 05:34
- Visual Basic(VBA) Excel VBA 最終行を取得しVlookup関数をコピーする方法をコーディングで教えてください。 3 2023/05/11 13:14
- Visual Basic(VBA) 特定の文字を含むシートだけマクロ処理をしたい 1 2023/05/22 01:43
- Excel(エクセル) 指定値をマクロで検索&シート移動 2 2022/04/27 23:29
- Excel(エクセル) ExcelのVLOOKUP関数 7 2022/08/23 06:46
- Excel(エクセル) VLOOKUP が機能しない、その原因は何 ? 8 2022/10/19 12:06
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
VBA シートをコピーする際に Co...
-
エクセルVBAが途中で止まります
-
別ブックをダイアログボックス...
-
VBS Bookを閉じるコード
-
ワイルドカード「*」を使うとう...
-
vbaでvbaProjectのパスワード解...
-
VBAで別ブックのシートを指定し...
-
【ExcelVBA】zip圧縮されたCSV...
-
【VBA】全シートの計算式を全て...
-
【ExcelVBA】インデックスが有...
-
複数のエクセルブックをひとつ...
-
拡張メタファイルにて貼り付け
-
複数のブックからデータを転記...
-
フォルダ内の全てのファイルに...
-
エクセルのマクロについて教え...
-
現在開いているbook全てを対象...
-
エクセルのマクロについて教え...
-
【前回の続きです、ご教示くだ...
-
VBAで複数のブックを開かずに処...
-
別ブックの列同士の値が一致し...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
VBA シートをコピーする際に Co...
-
エクセルVBAが途中で止まります
-
別ブックをダイアログボックス...
-
【ExcelVBA】インデックスが有...
-
ワイルドカード「*」を使うとう...
-
【ExcelVBA】VBA実行でダイアロ...
-
ExcelのVBAです。フォルダ内の...
-
フォルダ内の全てのファイルに...
-
VBA コードを実行すると画面が...
-
VBA 別ブックからコピペしたい...
-
VBAで別ブックのシートを指定し...
-
VBS Bookを閉じるコード
-
vbaでvbaProjectのパスワード解...
-
【VBA】全シートの計算式を全て...
-
VBA シート名が一致した場合の...
-
【ExcelVBA】zip圧縮されたCSV...
-
複数のエクセルブックをひとつ...
-
VBSでExcelのオープン確認
-
VBAで別のブックにシートをコピ...
-
【Excel VBA】書き込み先ブック...
おすすめ情報