![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?e8efa67)
お助けください。
当方Excel初心者です。表などは作成したことがあるものの、マクロや関数にはうといです。
仕事の関係で、複数のExcelファイルから、文字列を検索して、その文字列が含まれる行を他のファイルに抽出したいのですが、調べてみてもなかなかうまくいきませんでした。
例えば
A B C
商品名 商品コード 価格
だいこん 000000 100
きゅうり 111111 50
にんじん 222222 50
レタス 333333 100
などが入っているシートがたくさんあり、それがショップごとにファイル分けされています。
それらのファイルは同一のフォルダ内にあり、その中からたとえば「きゅうり」と検索したら、
AからCまでのデータが抽出できるようにしたいのです。
色々調べてみて、検索した言葉のセルだけは抽出できたのですが、
行全体までは抽出できませんでした。
どなたかお知恵を拝借させてください。
作業環境 Windows7
使用Excel 2013
ちなみにセルのみ抽出できたコードは以下になります。
Sub Search()
Dim WS As Worksheet
Dim myfolder As String
Dim Str As String
Dim a As Single
Dim sht As Worksheet
Set WS = Sheets.Add
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
myfolder = .SelectedItems(1) & "\"
End With
Str = Application.InputBox(prompt:="検索文字列:", Title:="今指定したフォルダにある全Excelファイルを検索します", Type:=2)
If Str = "False" Then Exit Sub
If Str = "" Then Exit Sub
WS.Range("A1") = "検索文字列:"
WS.Range("B1") = Str
WS.Range("A2") = "パス:"
WS.Range("B2") = myfolder
WS.Range("A3") = "ファイル名"
WS.Range("B3") = "シート名"
WS.Range("C3") = "検索結果"
a = 0
Application.ScreenUpdating = False
Value = Dir(myfolder)
Do Until Value = ""
If Value = "." Or Value = ".." Then
Else
If Right(Value, 3) = "xls" Or Right(Value, 4) = "xlsx" Or Right(Value, 4) = "xlsm" Then
On Error Resume Next
Workbooks.Open Filename:=myfolder & Value, Password:="zzzzzzzzzzzz"
If Err.Number > 0 Then
WS.Range("A4").Offset(a, 0).Value = Value
WS.Range("B4").Offset(a, 0).Value = "Password protected"
a = a + 1
Else
On Error GoTo 0
For Each sht In ActiveWorkbook.Worksheets
'セルの文字列に完全マッチしたいならxlWholeを使う。部分マッチしたいならxlPartを使う。
' Set c = sht.Cells.Find(Str, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
Set c = sht.Cells.Find(Str, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not c Is Nothing Then
firstAddress = c.Address
Do
WS.Range("A4").Offset(a, 0).Value = Value
WS.Range("B4").Offset(a, 0).Value = sht.Name
WS.Range("C4").Offset(a, 0).Value = c.Value
a = a + 1
Set c = sht.Cells.FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
Next sht
End If
Workbooks(Value).Close False
On Error GoTo 0
End If
End If
Value = Dir
Loop
Application.ScreenUpdating = True
Cells.EntireColumn.AutoFit
End Sub
No.4ベストアンサー
- 回答日時:
こんにちは。
初心者にしては、ずいぶん込み入ったものをお作りなりますね。
お世辞抜きで、初心者でしたら出来過ぎです。
内容もよくできているように思いますが、ただ、今の時点では解決できない問題も含まれていますので、なかなか厄介です。
また、初心者として名乗れる間に、初歩的な部分は直しておいたほうがよいことがあります。特に、Value はプロパティ名ですから、それでエラーにはならないにしても、使い勝手がよくありません。また、Str というのは、UserFormのTextBox に使う関数名です。VB.Net では自由ですが、VBAは、VB6のDNAがあるので、あまり良くありません。カウンター変数は、「i」から始まるとか……。
変数は、ある程度の決まりがありますから、それを逸脱すると、あとでややこしいことになります。(必ずしも、私が守っているとは言い切れませんが、ちゃんとした変数の付け方をしている人はエラーの度合いも少ないです。)
参考は、Excel大辞典 (ただし以下の内容は、古いですから、全部を真似ることはありません。理由を述べると長くなりますが、MS社では、この書き方を現在は推進していません。)
http://home.att.ne.jp/zeta/gen/excel/c04p15.htm
私が書き直してみましたが、以下には、はっきりとした欠陥がひとつあります。パスワードエラーを認めていません。パスワード付きとパスワードなしのブックのみで、そもそもオープン時のエラーを対処するコードを今の時点では思いつかなかったのです。すべてに同じパスワードが入っている場合は、問題がありません。したがって、ファイルオープン時のエラーについては、記録することができません。
'///
Option Explicit
Const MPSWD As String = "ZZZZ" 'パスワードはコードの外に置きます
Sub SeartchingWordsPrc()
Dim wb As Workbook
Dim myFolder As String
Dim strTxt As String
Dim i As Long, c As Variant
Dim sh As Worksheet
Dim mySh As Worksheet
Dim Fname As Variant
Dim FirstAddress As String
Set mySh = Worksheets.Add(After:=Worksheets(ThisWorkbook.Worksheets.Count))
''Set mySh = ThisWorkbook.ActiveSheet 'アクティブシートの場合
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show Then
myFolder = .SelectedItems(1) & "\"
End If
End With
If Trim(myFolder) = "" Then Exit Sub
strTxt = Application.InputBox(prompt:="検索文字列:", Title:="今指定したフォルダにある全Excelファイルを検索します", Type:=2)
If strTxt = "False" Or strTxt = "" Then Exit Sub
With mySh 'ここはまとめました*
.Range("A1").Resize(, 2).Value = Array("検索文字列:", strTxt)
.Range("A2").Resize(, 2).Value = Array("パス:", myFolder)
.Range("A3").Resize(, 3).Value = Array("ファイル名:", "シート名:", "検索結果")
End With
i = 4 '初期行設定
On Error GoTo errHandler
Application.ScreenUpdating = False
''----Start -----
Fname = Dir(myFolder & "*.xls?", vbNormal)
Do Until Fname = ""
If Fname <> "." And Fname <> ".." Then
Application.DisplayAlerts = False
Set wb = Workbooks.Open(myFolder & Fname, , Password:="", WriteResPassword:="")
Application.DisplayAlerts = True
If wb Is Nothing Then
With mySh 'ここが生きていません。*
.Cells(i, "A").Value = Fname
.Cells(i, "B").Value = "Password protected"
i = i + 1
End With
Else
For Each sh In wb.Worksheets
With sh
'セルの文字列に完全マッチしたいなら
'xlWholeを使う。部分マッチしたいならxlPartを使う。
'現在は、部分マッチで、ワイルドカードにしています。*
Set c = .UsedRange.Find(strTxt & "*", _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
With mySh
.Cells(i, "A").Value = Fname
.Cells(i, "B").Value = sh.Name
.Cells(i, "C").Value = c.Value
End With
i = i + 1
Set c = sh.UsedRange.FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
End With
Next sh
End If
DoEvents
wb.Close False
Set wb = Nothing
Beep
End If
Fname = Dir
Loop
Application.ScreenUpdating = True
mySh.Cells.EntireColumn.AutoFit
Exit Sub
errHandler: '*
If Err.Number = 1004 Then
Application.DisplayAlerts = False
On Error Resume Next
Set wb = Workbooks.Open(myFolder & Fname, , Password:=MPSWD, WriteResPassword:=MPSWD)
On Error GoTo 0
Application.DisplayAlerts = True
Resume Next
End If
End Sub
こんにちは
すごくていねいな回答をありがとうございます
そして手直しまでありがとうございます
まだ行全体を抽出するところまではできておりませんが、もう少し自分でも理解しないとだめだなと思いました
特に基礎部分ですね、反省しきりです
恥ずかしながらマクロや関数は殆どわからず、調べながらですが、意味もあまり理解せずに書いておりましたので
至らない点がたくさんあって申し訳ありません
リンク貼っていただいたEXCEL大辞典も実は見てみたのですがちんぷんかんぷんで…
今回は急ぎであまり勉強する時間がなかったのですが、これを機会にきちんと理解できるように勉強しようと思います
どうもありがとうございました
No.5
- 回答日時:
返事、ありがとうございます。
少し、最初コードを見た時に、切り分けるべきかどうか、迷いました。少し、コードが長すぎるようです。
ふつうは、作業のグループによって、プロシージャを別けるのです。
ここの作業では、2つか3つに分けます。
・ファイルの検索
・(ファイルのチェック)
・ファイルを開けて、その中身を検索する。見つけたら、その記録を取る-ブックを閉じる。
私は、そのファイルのパスワード・チェックが、ネックになってしまいました。パスワードはわかっているという前提で進めないと途中で止まってしまうのです。
パスワード付きか、そうでないかは、いくつかの方法で調べることは可能です。
>リンク貼っていただいたEXCEL大辞典も実は見てみたのですがちんぷんかんぷんで…
そうでしたか。最近は、Excelの『コーディング規約』が言われるようになりました。VBAできっちり守ったところであまり意味がないようなものですが、間違いが減りますね。
http://qiita.com/mima_ita/items/8b0eec3b5a81f168 …
http://blog.goo.ne.jp/pianyi/e/8945568a7ad880544 …
(この内容は、ざっくばらんで興味深いです)
後は、インデンターがあれば、きれいにコードを書けるようになります。
https://www.add-ins.com/macro-products-for-Micro …
本当は、プロシージャ名の命名法というのがあったりするのですが、今回、
Sub SeartchingWordsPrc() 綴を間違えてしまいました。(^^;
正しくは、Sub SearchingWordsPrc() です。
dokurocat様も、きっとすぐにベテランの域に入ってしまい、こんな話もできなくなってしまうでしょうけれども、私などは、いつまで経っても基本的なところから抜け出さないでいます。
こんばんは
すごくわかりやすいリンクをありがとうございます(*´∀`*)
二つ目はやっちゃいけないことなど書いてあって、とても助かります
今回は急にマクロ組んでくれと言われて慌てていたので、こうやってちゃんと最初から学ばないと
本当にできるものもできないなぁ、と嫌と言うほどわかりました
このコードは実は海外のサイトからひっぱってきたもので、それを独学で直したりしたので
余計におかしなことになっているのだと思います
いえ、本当に色々と助かりますし、まだ初心者から当分抜け出せないと思います
ご丁寧に何度も回答ありがとうございます
個人的に先生になっていただきたいほどです
でもいつまでもお手を煩わせてはいけないので、これで締め切らせていただきますね
何から何まで、本当にありがとうございました!
No.3
- 回答日時:
>これをどこに挿入すればいいですか?
は?
>検索した言葉のセルだけは抽出できたのですが、
>行全体までは抽出できませんでした。
出来てるんじゃないの?
出来てる前提の答えでした。
なんだこれ?
Dir終わってないのにFindしてるじゃん。
いやいや、全部並んでから検索しませう。
文字並べてる途中で検索って変だと思わないの?
Set c =
で始まるところが見つけるところなんで
No1とかNo2を使って.copyでコピーしといて
後で貼り付けます。
貼り付けは、今は代入してるけど
WS.Range("A4").Offset(a, 0).Value = Value
のところに
WS.Range("A4").Offset(a, 0).PasteSpetial
みたいな感じ?勿論残りの代入は要りません。
ただその前にまずは、今述べた通り
DirとFindは別ループにしないと
完全に無駄です。
これで抽出できてたのでできてると思っていました。
DirとFindを別にするんですね。
わかりましたやってみます。ありがとうございました。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
このQ&Aを見た人はこんなQ&Aも見ています
-
「これはヤバかったな」という遅刻エピソード
寝坊だったり、不測の事態だったり、いずれにしても遅刻の思い出はいつ思い出しても冷や汗をかいてしまいますよね。特にものすごく怒られたときとか、とんでもない損害を与えてしまったときとか…。
-
エクセルでファイルを開かずに文字を検索し、行を抽出したい
Excel(エクセル)
-
複数のエクセルファイル内を検索する方法
Excel(エクセル)
-
フォルダ内の複数ファイルから、特定セルだけを抽出し、並び替えて集約したい
Excel(エクセル)
-
-
4
Exel VBA 別ブックから該当データを検索し、必要なデータを取得する方法について
Visual Basic(VBA)
-
5
複数エクセルから特定シートの特定行だけを別シートに抽出するマクロ
Excel(エクセル)
-
6
ある文字列を含む行の抽出
Excel(エクセル)
-
7
EXCELで複数のファイルから抽出
Excel(エクセル)
-
8
csvファイルを開かずに文字を検索し行を抽出したい
Visual Basic(VBA)
-
9
excel2010 マクロで複数シート検索し、一致した行をコピーしたい
Excel(エクセル)
-
10
vlookup で複数のファイルを指定出来ますか
Excel(エクセル)
-
11
VBA 最終行まで数式をコピーする
Visual Basic(VBA)
-
12
VBAでファイルを開くときにファイル名でワイルドカードを使用したいです
その他(プログラミング・Web制作)
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
創価学会などの新興宗教信者の...
-
タバコの味ってライターで変わ...
-
なよなよした男性に嫌悪感
-
こいつやお前と呼ぶ男性心理は?
-
太った女性に好かれる男の容姿...
-
気になる人と初デートで嘔吐し...
-
年上の女性と付き合いたいです...
-
マッチングアプリについてです...
-
マッチングアプリで再マッチし...
-
好きな人がお見合いをします。
-
マッチングアプリでマッチした...
-
恋愛感情がない相手にも自宅住...
-
彼氏がいるのにお見合いしますか?
-
マッチングアプリでマッチした...
-
ログファイルを後ろから検索し...
-
マッチングアプリで再マッチし...
-
わたしにはB型の彼氏がいます
-
ExcelでRegExpのFunctionの作成
-
未成年はzippo購入不可ですか?
-
周りから
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
こいつやお前と呼ぶ男性心理は?
-
タバコの味ってライターで変わ...
-
恋愛感情がない相手にも自宅住...
-
太った女性に好かれる男の容姿...
-
なよなよした男性に嫌悪感
-
初デートのあと返信が極端に遅...
-
マッチングアプリでマッチした...
-
創価学会などの新興宗教信者の...
-
マッチとライター。どちらがコ...
-
年上の女性と付き合いたいです...
-
マッチングアプリで再マッチし...
-
気になる人と初デートで嘔吐し...
-
マッチングアプリで再マッチし...
-
周りから
-
ログファイルを後ろから検索し...
-
マッチングアプリについてです...
-
マッチングアプリでマッチした...
-
未成年はzippo購入不可ですか?
-
彼女が好きでもマッチングアプ...
-
マッチングアプリで医学部の人...
おすすめ情報