• ベストアンサー
  • 困ってます

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

  • 質問No.4859752
  • 閲覧数1384
  • ありがとう数6
  • 回答数4

お礼率 100% (4/4)

エクセルで以下の処理を行えるマクロを作成したいです。
当方、マクロについてほとんど知識がありません。
恐縮ですが、教えていただけると嬉しいです。

・主にしたいこと

 [検索]ブックで一致するコードを探して、
 [結果]ブックの対応するコードの行にそれぞれの項目を返したい。


●ブック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等の関数で表示することを考えましたが、
シートが複数にまたがっているのと、
列の並び方が[検索][結果]ブックで違うのでわかりませんでした。

長くなってしまい申し訳ありませんが、どうかおしえてください。
よろしくお願いします。

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

  • 回答No.4
  • ベストアンサー

ベストアンサー率 74% (396/532)

 先ず、
>[検索]ブックは共有ですが、[結果]ブックは各人によって名前がちがいます。
>たとえば、[結果_鈴木_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

お礼率 100% (4/4)

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

おかげさまで思い描いたとおりの動きが出来ました。
本当に助かりました。ありがとうございました。
投稿日時:2009/04/09 16:49

その他の回答 (全3件)

  • 回答No.3

ベストアンサー率 74% (396/532)

[回答番号:No.2] の DOUGLAS_ です。

>「結果.xls」のシートモジュールに書きます。
と書いておりますが、「シートモジュール」というのは、ワークシートのシートタブを右クリック [コードの表示(V)] をクリックして出てくるコードウィンドウにコピペなさってください。
 そのまま VBE(Visual Basic Editor)を閉じて、そのシートのB列に「SS3456」というようなデータが入力されると、自動でA・C・D列にデータが入ります。

 コードの先頭に
Private Sub Worksheet_Change(~~)
と書いてありますのは、そのワークシートがチェンジ(変化)したときに自動で始まるマクロです。これを「チェインジイベント」といいます。

 で、このような「イベント」は
>ツール→マクロ→マクロの一覧に出て
きませんし、そこから実行するものではありません。


>無理やり実行しようとすると「引数は省略できません」となってしまいます
 どのようにして「無理やり実行」されたのか存じませんが、上記のようにしてみられて、それでもエラーが出るようでしたら、またお知らせください。
お礼コメント
123aki123

お礼率 100% (4/4)

DOUGLAS_様、ありがとうございます!!!
早速ご指導のとおりにやってみましたところ、できました~~~!!!
無知すぎて申し訳ないです。。。丁寧に教えてくださりありがとうございました。

大変厚かましいのですが、重ねてお尋ねしてもよろしいでしょうか?
・チェンジイベントとは、その名のとおりチェンジしたときしか変更されないのでしょうか?
 たとえば、元の[検索]ブックの内容が変更されたときも、
 [結果]ブックの「コード」を変更しないと、[検索]ブックで行った変更は反映されないのでしょうか。
 自動的に再計算させるということは不可能なのでしょうか??

・バイト先でシフト管理のために使いたいと思っているのですが、
 [検索]ブックは共有ですが、[結果]ブックは各人によって名前がちがいます。
 たとえば、[結果_鈴木_2008.xls]といったものです。
 これは各人でマクロのコードを変更してもらうしかないのでしょうか?

もしお時間ありましたら教えてくださいますと嬉しいです。
(重ねての質問が不適切でしたらご指摘ください。新しく質問を投稿したほうが良いのでしょうか???)
投稿日時:2009/04/08 10:57
  • 回答No.2

ベストアンサー率 74% (396/532)

 もっとよいコーディングがあろうかとも存じますが、一応、こんなところでできないことはなさそうですが。。。

 「検索.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

お礼率 100% (4/4)

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

ベストアンサー率 33% (959/2869)

「検索」をシート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

お礼率 100% (4/4)

回答ありがとうございます!
マクロは本当にはじめたばかりで、
見てもあまりまだ理解もできないのですが…><参考になります!
ありがとうございます。
投稿日時:2009/04/07 18:21
関連するQ&A

その他の関連するQ&Aをキーワードで探す

ピックアップ

ページ先頭へ