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

Question

エクセルで以下の処理を行えるマクロを作成したいです。
当方、マクロについてほとんど知識がありません。
恐縮ですが、教えていただけると嬉しいです。

・主にしたいこと

　[検索]ブックで一致するコードを探して、
　[結果]ブックの対応するコードの行にそれぞれの項目を返したい。


●ブック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_ · Accepted Answer

先ず、
＞[検索]ブックは共有ですが、[結果]ブックは各人によって名前がちがいます。
＞たとえば、[結果_鈴木_2008.xls]といったものです。
＞これは各人でマクロのコードを変更してもらうしかないのでしょうか？
につきましては、その必要はありません。

Windows("結果.xls").Activate
の行を
ThisWorkbook.Activate
に書き換えると、どの「[結果]ブック」でも使うことはできます。

-------------------------------------------------------------------

　次に
＞・チェンジイベントとは、その名のとおりチェンジしたときしか変更されないのでしょうか？
＞たとえば、元の[検索]ブックの内容が変更されたときも、
＞[結果]ブックの「コード」を変更しないと、[検索]ブックで行った変更は反映されないのでしょうか。
につきましては、その通りですが、
＞自動的に再計算させ
たいということでしたら、逆に「[検索]ブック」の方に チェインジイベント を書いて、「[結果]ブック」の内容を書き改めさせるというような段取りになるかと存じます。


　が、しかし、

１）
＞[結果]ブックは各人によって名前がちがいます。
ということでしたら、全員の「[結果]ブック」を書き換えないといけないので、手落ちが起こりやすい。

２）ある程度 マクロ とか VBA をご自分で記述できない場合は、運用は難しい。

ということになろうかと存じます。


　このような場合は、「共有の[検索]ブック」にある１２個のシートを、「[検索]ブック」の中で、１３個目のシートに一旦集約しておき、「[結果]ブック」には関数でデータを拾ってくるというのが、安全かつ簡便かと存じます。

-------------------------------------------------------------------
● 《《「[検索]ブック」の中で、１３個目のシートに一旦集約》》 する方法
１）「[検索]ブック」に新しいシートを挿入し「集約」と名前を付けます。
２）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))
という式をコピペします。
　すると、Ｅ１に シート1～12 のデータの入力された最大の行数が返ります。
３）A2 に
=OFFSET(INDIRECT(ADDRESS(1,COLUMN(A1),2,,ROUNDUP(ROW(A1)/$E$1,0))),MOD(ROW(A1)-1,$E$1)+1,0)
と入力し、B2:D2 にコピーします。
４）A2:D2 を下方向に数百行コピーします。
　ここで言う「数百行」とは、最低「E1 の数字×１２」ですが、余分にコピーすると「#REF!」が表示されますけれども、今後、各シートにどんどんデータが増えるのであれば、余分に何百行もコピーしていても構いません。
５）最後に「集約」シートを保護し非表示にします。



● 《《「[結果]ブック」には関数でデータを拾ってくる》》 方法
　「結果.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

DOUGLAS_ · Answer

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

DOUGLAS_ · Answer

もっとよいコーディングがあろうかとも存じますが、一応、こんなところでできないことはなさそうですが。。。

　「検索.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

n-jun · Answer

「検索」をシート１、「結果」をシート２とした場合なら、

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

例えばこんなとか？
ただ同一ブックの単シートでは既にコードが出来ているのなら、これはスル～して下さい。

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

先ず、

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

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

「検索」をシート１、「結果」をシート２とした場合なら、

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

　先ず、

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