VBA初心者の異なるBookからの検索に関する質問

このQ&Aのポイント
  • VBA初心者が異なるBookからの検索方法について相談しています。集計ファイルのセルを野菜と果物ファイルから検索したいとのことです。
  • 現在、Set myRng = myFLd.Find(what:=i, lookat:=xlWhole)の部分でエラーが発生しており、解決法を求めています。
  • また、質問者はこの方法が正しいかどうかも知りたいとしています。アドバイスを求めています。
回答を見る
  • ベストアンサー

異なるBookからの検索

VBA初心者です。 集計.exl 野菜.exl 果物.exlとファイルがあり、野菜と果物にはシートが3枚づつあります。 集計ファイルのセルを野菜と果物ファイルから検索したいのです。 本等を見て調べたのですが、異なるBookからの検索方法が見つかりません。 Private Sub kensaku() Dim i As Integer Dim myFLd As Range, myRng As Range ' i = Cells("3,2").Select Workbooks.Open ("C:\果物.xls") Worksheets.Select Set myRng = myFLd.Find(what:=i, lookat:=xlWhole) If myRng Is Nothing Then Workbooks.Open ("野菜.xls") Worksheets.Select Set myRng = myFLd.Find(what:=i, lookat:=xlWhole) Exit Sub End If If myRng Is Nothing Then MsgBox "ありません" Exit Sub End If MsgBox "対象" & myRng.Address End Sub としたのですが、 Set myRng = myFLd.Find(what:=i, lookat:=xlWhole) 部分のエラー(whitがありません)とでて、直りません。 あと、このやり方であっているのでしょうか? アドバイスお願いします。

noname#15127
noname#15127

質問者が選んだベストアンサー

  • ベストアンサー
  • papayuka
  • ベストアンサー率45% (1388/3066)
回答No.2

> Selectにしたのはvalueでは指定のセルに行かないんです。 行くとか行かないとかでは無く、Selectではダメです。 これでは i は必ず True(-1) です。 また、変数や構文もおかしいです。 what:=Range(i).Value や .Activate や myRng Is Nothing や myRng.Address 以下はマクロがあるブックのアクティブシートのセル M6 にある値と部分一致するものを 果物.xls の全シートから検索して、最初に見つかったセルを表示します。 Sub Test() Dim wb1 As Workbook, ws As Worksheet, i, c  i = ThisWorkbook.ActiveSheet.Cells(6, "M").Value  Set wb1 = Workbooks.Open("C:\果物.xls ", UpdateLinks:=0)  For Each ws In wb1.Worksheets   Set c = ws.Cells.Find(what:=i, lookat:=xlPart)   If Not c Is Nothing Then Exit For  Next ws  If Not c Is Nothing Then   MsgBox "「" & i & "」 は " & wb1.Name & " " & ws.Name & "!" & _       c.Address & "にあります。" & _       vbCrLf & "内容は 「" & c.Value & "」", vbInformation  Else   MsgBox wb1.Name & " に対象は見つかりません。", vbCritical  End If  wb1.Close SaveChanges:=False End Sub

noname#15127
質問者

お礼

ありがとうございました。 勉強になりました。 これからも頑張って勉強します。

その他の回答 (1)

  • papayuka
  • ベストアンサー率45% (1388/3066)
回答No.1

Excelのバージョンが不明ですが、正直かなりおかしいです。 i = Cells("3,2").Select はたぶん  i = Cells(3,2).value myFLd も何もセットされてないのでまともに動かないでしょう。 Exit Sub を多用してますが、Subを抜けろって事なのでそこを通った時点で処理が終わってしまいます。 集計.xls の??シートのB3の値は、果物.xls や 野菜.xls の各シートの何処か1ヶ所にしか無いのでしょうか?

noname#15127
質問者

補足

回答ありがとうございます。 Selectにしたのはvalueでは指定のセルに行かないんです。 (""は気づき取りました) papayukaさんご指摘の通りmyFLd も何もセットされてないので空で検索しているみたいです。 下記のように書き直したので、もう一度見てもらえますか? i = Cells(6, "M").Select Set wb1 = Workbooks.Open("C:\果物.xls ", UpdateLinks:=0) Sheets("A商店").Select Set C = Cells.Find(what:=Range(i).Value, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False).Activate If myRng Is Nothing Then MsgBox "ありません" Exit Sub End If MsgBox "対象" & myRng.Address End Sub

関連するQ&A

  • 番号検索

    社員テーブルの4桁で構成される社員番号から検索するマクロを下記にて組みました。しかし、4桁の社員番号からではなく各自宅電話番号の10桁の数字から検索するために社員番号を各自宅の電話番号10桁の番号に変え入力フォームのC4のセルに10桁の数値を入れて検索したところマクロが作動しなくなりました。ご教示願います Sub ボタン1_Click() Dim tmpInt As Integer, motoHani(), myRng As Range, i As Integer tmpInt = Worksheets("入力フォーム").Range("C4").Value motoHani = Array("C6", "C7", "C8", "F8", "C10", "C11") Set myRng = Range("社員テーブル").Columns(1).Find(tmpInt, LookAt:=xlWhole) If myRng Is Nothing Then MsgBox "該当する事案はありません" Exit Sub End If For i = 0 To UBound(motoHani) Range(motoHani(i)).Value = myRng.Offset(0, i + 1) Next End Sub

  • データ検索後の上書き

    データシートに記載がある社員番号を入力フォームに入力し特定の社員データを検索するマクロを下記にて組みました。検索抽出された社員データを直接一部修正入力してもとの社員データヘ上書き処理をする(データによって修正しないこともあり)場合のマクロをご教示願います。 Sub ボタン1_Click() Dim tmpInt As Integer, motoHani(), myRng As Range, i As Integer tmpInt = Worksheets("入力フォーム").Range("C4").Value motoHani = Array("C6", "C7", "C8", "F8", "C10", "C11") Set myRng = Range("社員テーブル").Columns(1).Find(tmpInt, LookAt:=xlWhole) If myRng Is Nothing Then MsgBox "該当する事案はありません" Exit Sub End If For i = 0 To UBound(motoHani) Range(motoHani(i)).Value = myRng.Offset(0, i + 1) Next End Sub

  • ブック全体の検索の次へは?

    ブック全体を検索するマクロ作ったのですが、 ブックの最初にあるものしか見つけられません。 見つかった時に、次の検索を行うにはどのようなVBAになるのでしょうか? よろしくお願いもうしあげます。 Sub KensakuAll() 'ブック内の全シートを検索   Dim myWb As Workbook   Dim mySht As Worksheet   Dim myRng As Range   Dim Key1 As String   Key1 = InputBox("検索キーを入力しなさい")   If Key1 = "" Then Exit Sub   For Each mySht In Sheets     Set myRng = mySht.Cells.Find(what:=Key1)     If Not myRng Is Nothing Then       mySht.Activate       myRng.Activate       Set mySht = Nothing       Set myRng = Nothing       Exit Sub     End If   Next   MsgBox "該当するセルは見つかりませんでした"   Set mySht = Nothing   Set myRng = Nothing End Sub

  • 検索して修正したデータの上書転記

    Sub 検索() Dim tmpInt As Integer, motoHani(), myRng As Range, i As Integer tmpInt = Sheets("入力フォーム").Range("C4").Value motoHani = Array("C10", "C12", "C13") Set myRng = Range("テーブル").Columns(1).Find(tmpInt, LookAt:=xlWhole) If myRng Is Nothing Then MsgBox "該当するレコードはありませんでした" Exit Sub End If For i = 0 To UBound(motoHani) Range(motoHani(i)).Value = myRng.Offset(0, i + 1) Next End Sub 入力シートと一覧表シートを作成し入力シートの入力フォームにデータを入れてマクロを実行すると一覧表シートにレコード転記されるようにしました。 一覧表シートに転記したデータを,検索し入力フォーム上に表示させることはできたのですが、データを修正して一覧表シートに更新(上書転記)させる方法がわかりません。どうかご存知の方、教えてください。

  • 改行のあるセルをFindで検索したい

    エクセルです。 A1セルに 「あああ」と入力して、ALT+Enterで改行し、「いいい」と入力しました。 VBAで Sub test() MsgBox Cells.Find(What:="あああ" & Chr(13) & "いいい", LookAt:=xlWhole).Address End Sub として、セル番地を取得したいのですが オブジェクト変数または With ブロック変数が設定されていません。(Error 91) と言うエラーが返ってきてしまいます。 $a$1が返ってきてほしいのですが。 Sub test() Debug.Print Cells.Find(What:="あああ*", LookAt:=xlWhole).Address End Sub で、$a$1が返ってきますが、 できれば改行含む検索ができるようになりたいです。

  • エクセル マクロ 検索

    お世話になります。 範囲がA2からK221までの表があります。 検索して検索されたセルの左のセルを表示するマクロを組みたいのですが、検索する文字(数値)はE1に、検索結果はK1に表示するようにするにはどのようにしたらいいでしょうか? Sub FIND_DATA1() ' FIND_DATA1 Macro ' マクロ記録日 : 2006/9/1 ユーザー名 : ' Cells.Find(What:=Range("E1").Value, After:=ActiveCell, lookAt:=xlWhole).Activate End Sub Sub Data_Find3() Dim 対象セル As Range Dim 最初のセル番地 As String Dim 検索件数 As Long Cells.Interior.ColorIndex = xlNone If Range("E1").Value = "" Then Exit Sub End If Set 対象セル = Cells.Find(What:=Range("E1").Value, After:=ActiveCell, lookAt:=xlWhole) 最初のセル番地 = 対象セル.Address Do 対象セル.Interior.ColorIndex = 37 検索件数 = 検索件数 + 1 Set 対象セル = Cells.FindNext(対象セル) Loop While 対象セル.Address <> 最初のセル番地 MsgBox "検索件数は" & 検索件数 - 1 & " 件です" End Sub 本を見たり調べたりでここまでできたんですがこれだと検索件数、検索結果が色付きになるだけで使い勝手がいまいちです。 よろしくお願いします。

  • Findステートメントで別なブックの検索

    Findステートメントで検索した内容のある行のA列にある値をキーワードとして別なブックのA列に検索をかけてヒットしたセルの内容を元のブックの指定したセルに移すという動作をさせたいので次ののように書いてみました。 Private Sub CommandButton2_Click() Dim Yline As Long Dim No As Variant Dim c As Range Dim sh As Worksheet Dim sh_no As Integer Dim findcell As Range Dim add As String Set sh = Worksheets("ブックAの1") No = TextBox1.Text sh_no = 1 'テキストボックスに値が入っていた場合 If No <> "" Then 'Find メソッドの最低のプロパティは入れる。SearchOrder は特にいらない Set c = sh.Range("B:B").Find( _ What:=No, _ LookIn:=xlValues, _ LookAt:=xlPart, _ Searchorder:=xlByRows) '見つかった場合にのみ、値を入れる If Not c Is Nothing Then Yline = c.Row '見つかった行のA列の文字列でブックBに検索をかける add = sh.Cells(Yline, 1).Value Workbooks("B").Activate Set findcell = Workbooks("B").Worksheet(sh_no).Range("A:A").Find( _ What:=add, _ LookIn:=xlValues, _ LookAt:=xlPart, _ Searchorder:=xlByRows) '前Setステートメントからのループ検索開始 If findcell Is Nothing Then Do sh_no = sh_no + 1 If sh_no > ThisWorkbook.Worksheets.Count Then Exit Sub End If Set findcell = Workbooks("B").Worksheets.(sh_no).Range("A:A").Find( _ What:=add, _ LookIn:=xlValues, _ LookAt:=xlPart, _ Searchorder:=xlByRows) Loop While findcell Is Nothing End If End If Workbooks("A").Activate With Worksheets("Aの2")   .Cells(21, 4).Value = sh.Cells(Yline, 14).Value .Cells(20, 4).Value = sh.Cells(Yline, 15).Value .Cells(36, 4).Value = findcell End With Unload Me Else MsgBox No & " は見つかりません。", 48 End If Set sh = Nothing End Sub するとwhat:=addとしてaddが見つかるまでシート番号を増やしていくループのところでエラーがでてキーワードが見つからないと出ます。恐らくブックBを検索してくれているとは思うのです。A列に空白があるためかと思い埋めてみましたが関係ないようです。 構文エラー的なものは無いと思いますが、宜しくお願いします。

  • 特定文がある行を削除

    特定分がある行を削除しようと思い、以下のように設定いたしました。 Sub DelLines() Dim R As Range Do Set R = ActiveSheet.Range("A:A").Find(What:="指定文", LookAt:=xlWhole) If R Is Nothing Then Exit Sub R.EntireRow.Delete Loop End Sub これを、全てのシートに適用するにはどのように書けばよろしいのでしょうか?

  • 2つブック IDが重複しても転記を行う方法

    2つのブックでIDが一致したら 横にある文字を転記するというマクロがあるのですが 同じIDが続いても転記先のエクセルに全て転記したいのですが IFか ELSE CASEで条件分岐させればよろしいのでしょうか? 下記にマクロのコードと構成と画像を記述させて頂きます お手数ですがご教授して頂けないでしょうか? 恐縮ですがよろしくお願いいたします。 Sub 転記() Dim w0 As Worksheet, w1 As Worksheet Dim h As Range, Target As Range Set w0 = Workbooks("IDデータ.xls").Worksheets(1) Set w1 = Workbooks("ID管理票.xls").Worksheets(1) For Each h In w0.Range("A2:A" & w0.Range("A65536").End(xlUp).Row) Set Target = w1.Range("D11:D60000").Find(what:=h.Value, LookIn:=xlValues, lookat:=xlWhole) If Not Target Is Nothing Then Select Case h.Offset(0, 1).Value Case "確認" Target.Offset(0, -1) = h.Offset(0, 1).Value Case Else End Select End If Next End Sub

  • マクロの関係で困ってしまいました。印刷できません

    Sub Sample3() Dim i As Long, k As Long, c As Range, r As Range i = InputBox("入替え元番号を入力") k = InputBox("入替え先番号を入力") Set c = Range("A:A").Find(what:=i, LookIn:=xlValues, lookat:=xlWhole) Set r = Range("A:A").Find(what:=k, LookIn:=xlValues, lookat:=xlWhole) On Error Resume Next If c.Row < r.Row Then i = c.Row k = r.Row Else i = r.Row k = c.Row End If Rows(k + 1).Insert Rows(i).Cut Cells(k + 1, "A") Rows(k).Cut Cells(i, "A") Rows(k).Delete End Sub  上記のようなマクロを組んで頂いたのですが、「改ページ位置を移動できません」という状況になっています。せっかくgooの質問で答えて頂いたのですが、これでやったら80行ぐらいから、この表示が出て、解決できません。どなたか、解決して頂けませんか。その時に補足すればよかったのですが、動かしてみて分かった次第です。お答え頂いた方に大変申し訳なく思っています。よろしくお願いします。  なお、間違った入力をしてしまった時に、一回だけは元に戻るなんてことはできないですかね。これもできたら厚かましいですがお答え頂けたらと思います。

専門家に質問してみよう