• ベストアンサー

エクセルで別ブックを検索するマクロ、VBA

エクセルで以下の処理を行えるマクロを作成したいです。 当方、マクロについてほとんど知識がありません。 恐縮ですが、教えていただけると嬉しいです。 ・主にしたいこと  [検索]ブックで一致するコードを探して、  [結果]ブックの対応するコードの行にそれぞれの項目を返したい。 ●ブック1 [検索]  シートが12個あります(それぞれ、1、2、3…12というシート名=1~12月分)  ↓各シートの内容    A    B    C    D 1  氏名  数値  コード  内容 2  abc   111  SS1234 あいうえお 3  bcd   123  SS3456 かきくけこ ・ ・ ・ といった感じです。 12個のシートの中身はそれぞれ似たようなものですが、 「コード」や「内容」などは少しずつ違います。 ●ブック2 [結果]  ↓シートの内容    A    B    C    D 1  氏名  コード  内容  数値 2      SS3456 3      SS1234 ・ ・ ・ といった感じです。 (注)検索用ブックとは列の並びが異なっています。 ここでやりたいことの詳細ですが、 ・[結果]ブックの「コード」(B列)にコードを入力すると、  [検索]ブックで一致するコードを検索し、  A列「氏名」、C列「内容」、D列「数値」に、[検索]シートの内容を  自動的に表示させたい。  (ただし[結果]ブックに入力した「コード」は、[検索]ブックの1~12のうち、   どのシートにあるかわからない) ・入力したコードが見つからない場合は何も表示しない。 ということです。 最初VLOOKUP、MATCH等の関数で表示することを考えましたが、 シートが複数にまたがっているのと、 列の並び方が[検索][結果]ブックで違うのでわかりませんでした。 長くなってしまい申し訳ありませんが、どうかおしえてください。 よろしくお願いします。

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

  • ベストアンサー
  • DOUGLAS_
  • ベストアンサー率74% (397/534)
回答No.4

 先ず、 >[検索]ブックは共有ですが、[結果]ブックは各人によって名前がちがいます。 >たとえば、[結果_鈴木_2008.xls]といったものです。 >これは各人でマクロのコードを変更してもらうしかないのでしょうか? につきましては、その必要はありません。 Windows("結果.xls").Activate の行を ThisWorkbook.Activate に書き換えると、どの「[結果]ブック」でも使うことはできます。 -------------------------------------------------------------------  次に >・チェンジイベントとは、その名のとおりチェンジしたときしか変更されないのでしょうか? >たとえば、元の[検索]ブックの内容が変更されたときも、 >[結果]ブックの「コード」を変更しないと、[検索]ブックで行った変更は反映されないのでしょうか。 につきましては、その通りですが、 >自動的に再計算させ たいということでしたら、逆に「[検索]ブック」の方に チェインジイベント を書いて、「[結果]ブック」の内容を書き改めさせるというような段取りになるかと存じます。  が、しかし、 1) >[結果]ブックは各人によって名前がちがいます。 ということでしたら、全員の「[結果]ブック」を書き換えないといけないので、手落ちが起こりやすい。 2)ある程度 マクロ とか VBA をご自分で記述できない場合は、運用は難しい。 ということになろうかと存じます。  このような場合は、「共有の[検索]ブック」にある12個のシートを、「[検索]ブック」の中で、13個目のシートに一旦集約しておき、「[結果]ブック」には関数でデータを拾ってくるというのが、安全かつ簡便かと存じます。 ------------------------------------------------------------------- ● 《《「[検索]ブック」の中で、13個目のシートに一旦集約》》 する方法 1)「[検索]ブック」に新しいシートを挿入し「集約」と名前を付けます。 2)A1:D1 にそれぞれ、「氏名」・「数値」・「コード」・「内容」と入力し、E1 に =MAX(COUNTA('1'!A:A),COUNTA('2'!A:A),COUNTA('3'!A:A),COUNTA('4'!A:A),COUNTA('5'!A:A),COUNTA('6'!A:A),COUNTA('7'!A:A),COUNTA('8'!A:A),COUNTA('9'!A:A),COUNTA('10'!A:A),COUNTA('11'!A:A),COUNTA('12'!A:A)) という式をコピペします。  すると、E1に シート1~12 のデータの入力された最大の行数が返ります。 3)A2 に =OFFSET(INDIRECT(ADDRESS(1,COLUMN(A1),2,,ROUNDUP(ROW(A1)/$E$1,0))),MOD(ROW(A1)-1,$E$1)+1,0) と入力し、B2:D2 にコピーします。 4)A2:D2 を下方向に数百行コピーします。  ここで言う「数百行」とは、最低「E1 の数字×12」ですが、余分にコピーすると「#REF!」が表示されますけれども、今後、各シートにどんどんデータが増えるのであれば、余分に何百行もコピーしていても構いません。 5)最後に「集約」シートを保護し非表示にします。 ● 《《「[結果]ブック」には関数でデータを拾ってくる》》 方法  「結果.xls」のシートモジュールで、[回答番号:No.2] のコードを削除し、替わりに下記をコピペします。 Private Sub Worksheet_Change(ByVal Target As Range)  Dim myRng As Range  If Target.Column = 2 And Target.Count = 1 Then   With Workbooks("検索.xls").worksheets("集約").Columns(3)    Set myRng = .Find(What:=Target.Value, LookIn:=xlValues, _    LookAt:=xlWhole, MatchCase:=False, MatchByte:=False, SearchFormat:=False)   End With   Windows("結果.xls").Activate   Application.EnableEvents = False   If myRng Is Nothing Then    With Target     .Offset(, -1).Value = ""     .Offset(, 1).Value = ""     .Offset(, 2).Value = ""    End With   Else    With Target     .Offset(, -1).FormulaR1C1 = "=OFFSET([検索.xls]集約!R1C1,MATCH(RC2,[検索.xls]集約!C3,0)-1,0)"     .Offset(, 1).FormulaR1C1 = "=OFFSET([検索.xls]集約!R1C1,MATCH(RC2,[検索.xls]集約!C3,0)-1,3)"     .Offset(, 2).FormulaR1C1 = "=OFFSET([検索.xls]集約!R1C1,MATCH(RC2,[検索.xls]集約!C3,0)-1,1)"    End With   End If   Application.EnableEvents = True   Target.Offset(1).Select  End If End Sub

123aki123
質問者

お礼

DOUGLAS_様、わかりにくい質問にも関わらず、 大変ご丁寧に回答いただき本当にありがとうございます。 初心者の私にできるように、かつ手間がないように 関数等も作ってくださり・・・尊敬の念・感謝の念でいっぱいです。 おかげさまで思い描いたとおりの動きが出来ました。 本当に助かりました。ありがとうございました。

その他の回答 (3)

  • DOUGLAS_
  • ベストアンサー率74% (397/534)
回答No.3

[回答番号:No.2] の DOUGLAS_ です。 >「結果.xls」のシートモジュールに書きます。 と書いておりますが、「シートモジュール」というのは、ワークシートのシートタブを右クリック [コードの表示(V)] をクリックして出てくるコードウィンドウにコピペなさってください。  そのまま VBE(Visual Basic Editor)を閉じて、そのシートのB列に「SS3456」というようなデータが入力されると、自動でA・C・D列にデータが入ります。  コードの先頭に Private Sub Worksheet_Change(~~) と書いてありますのは、そのワークシートがチェンジ(変化)したときに自動で始まるマクロです。これを「チェインジイベント」といいます。  で、このような「イベント」は >ツール→マクロ→マクロの一覧に出て きませんし、そこから実行するものではありません。 >無理やり実行しようとすると「引数は省略できません」となってしまいます  どのようにして「無理やり実行」されたのか存じませんが、上記のようにしてみられて、それでもエラーが出るようでしたら、またお知らせください。

123aki123
質問者

お礼

DOUGLAS_様、ありがとうございます!!! 早速ご指導のとおりにやってみましたところ、できました~~~!!! 無知すぎて申し訳ないです。。。丁寧に教えてくださりありがとうございました。 大変厚かましいのですが、重ねてお尋ねしてもよろしいでしょうか? ・チェンジイベントとは、その名のとおりチェンジしたときしか変更されないのでしょうか?  たとえば、元の[検索]ブックの内容が変更されたときも、  [結果]ブックの「コード」を変更しないと、[検索]ブックで行った変更は反映されないのでしょうか。  自動的に再計算させるということは不可能なのでしょうか?? ・バイト先でシフト管理のために使いたいと思っているのですが、  [検索]ブックは共有ですが、[結果]ブックは各人によって名前がちがいます。  たとえば、[結果_鈴木_2008.xls]といったものです。  これは各人でマクロのコードを変更してもらうしかないのでしょうか? もしお時間ありましたら教えてくださいますと嬉しいです。 (重ねての質問が不適切でしたらご指摘ください。新しく質問を投稿したほうが良いのでしょうか???)

  • DOUGLAS_
  • ベストアンサー率74% (397/534)
回答No.2

 もっとよいコーディングがあろうかとも存じますが、一応、こんなところでできないことはなさそうですが。。。  「検索.xls」は予め開いてからお試しください。  「結果.xls」のシートモジュールに書きます。 Private Sub Worksheet_Change(ByVal Target As Range)  Dim myRng As Range  Dim myWS As Worksheet  If Target.Column = 2 And Target.Count = 1 Then   For Each myWS In Workbooks("検索.xls").Worksheets    With myWS.Columns(3)     Set myRng = .Find(What:=Target.Value, LookIn:=xlValues, _     LookAt:=xlWhole, MatchCase:=False, MatchByte:=False, SearchFormat:=False)    End With    If Not myRng Is Nothing Then     Exit For    End If   Next   Windows("結果.xls").Activate   Application.EnableEvents = False   If myRng Is Nothing Then    With Target     .Offset(, -1).Value = ""     .Offset(, 1).Value = ""     .Offset(, 2).Value = ""    End With   Else    With Target     .Offset(, -1).Value = myRng.Offset(, -2).Value     .Offset(, 1).Value = myRng.Offset(, 1).Value     .Offset(, 2).Value = myRng.Offset(, -1).Value    End With   End If   Application.EnableEvents = True   Target.Offset(1).Select  End If End Sub

123aki123
質問者

お礼

回答ありがとうございます! すごいです!!! 早速コピーさせていただき書いてみましたが、ツール→マクロ→マクロの一覧に出てこず、 無理やり実行しようとすると「引数は省略できません」となってしまいます>< 初心者すぎて恐縮ですが、登録の詳しい手順を教えていただけないでしょうか?>< よろしくお願い致します。。

  • n-jun
  • ベストアンサー率33% (959/2873)
回答No.1

「検索」をシート1、「結果」をシート2とした場合なら、 Sub try() Dim myDic As Object Dim i As Long, m As Long Dim r As Range Dim v Set myDic = CreateObject("Scripting.Dictionary") v = Worksheets("Sheet2").UsedRange For i = 2 To UBound(v, 1) myDic(v(i, 2)) = i Next With Worksheets("Sheet1") For Each r In .Range(.Range("C2"), .Cells(Rows.Count, 3).End(xlUp)) If myDic.Exists(r.Value) Then m = myDic(r.Value) v(m, 1) = r.Offset(, -2).Value v(m, 3) = r.Offset(, 1).Value v(m, 4) = r.Offset(, -1).Value End If Next End With With Worksheets("Sheet2") .Cells.ClearContents .Range("A1").Resize(UBound(v, 1), UBound(v, 2)).Value = v End With Set myDic = Nothing Erase v End Sub 例えばこんなとか? ただ同一ブックの単シートでは既にコードが出来ているのなら、これはスル~して下さい。

123aki123
質問者

お礼

回答ありがとうございます! マクロは本当にはじめたばかりで、 見てもあまりまだ理解もできないのですが…><参考になります! ありがとうございます。

関連するQ&A