徒然日記~オタクなオバサンの我がまま日記

ミステリィ、ゲーム、パソコン、ドラマ、など私好きなことについて熱く語っていきたいです。 出来れば 読んだ本に関する一言メモでも残せればいいなぁ~。

Entries

スポンサーサイト

上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

EXCEL VBA 複数シートからの検索、抽出

ジャンルを 趣味・実用にしたけど…
実用になるかしら

教えて! goo にちょっとはまっていて 昨日の質問に

B.xls と言うファイルにある7つのシートにあるデータがある。
ID,名前 住所などのデータ(らしい)
A.xls のシート(これは1つ)に IDを入力し それを元にB.xlsを 検索してAのシート上に そのIDの人の情報を表示する。

というのがあった。
関数をつかうらしいけど、実は関数は苦手。で 1日がかりでマクロを組んでみた。

以下その詳細

自分の勉強にと思い マクロを書いてみました。
ただしこれを使うには

Cドライブの"Test"フォルダに "Test_A.xls" "Test_B.xls"という2つのファイルが入っていることが必要です。

Test_B.xls は お使いのBのエクセルファイルを複製して名前を変えて保存してください。
2行目から データが入っており、A列にID、その右B,C,Dまで書き込みされているという設定です。

Test_A.xlsは 新しく作ってください。 ただし IDを入力するセルは ”E15” 結果を 表示するのは
”A25からD25”までになります。

最初に開くのは Test_A です。このファイルにマクロを書き込みます。

ツール(T)→マクロ→Visual Basic Editorをクリック。最大表示にしたほうがわかりやすいと思います。
プロジェクトと左上にあると思います。
Sheet1 をダブルクリックすると右に白い面が現れると思います。
何も書かれていない状態だと思いますのでここに点線の間のものをコピペしてください。
---------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim IDNum As String
Range("A25:D25").ClearContents
IDNum = Range("E15")
If IDNum <> "" Then

Call ID検索

End If

End Sub
---------------
シート1のE15に IDを入力した後 どこでも良いのでセルをダブルクリックすると
”ID検索” という プログラムに行きます。

続く

次は一番上の ツールバー(?だったかなこんな基本が解りません、笑い) の挿入(I)をくりっくして
その中から 標準モジュールを選んでください。
さきほどの プロジェクトのなかに Module1が増えたと思います。
これをダブルクリックして また次のものをコピペ して下さい。
”ID検索”です。
---------------
Sub ID検索()

Dim Ws As Integer
Dim IDNum As String
Dim I As Integer
Dim rg As Range
Dim pop As String
Dim Result As String
Dim RW As String


IDNum = Range("E15")
Application.ScreenUpdating = False

Workbooks.Open "C:\Test\Test_B.xls"
Ws = Worksheets.Count
For I = 1 To Ws

With Worksheets(I)
pop = .Range("A2").End(xlDown).Address
For Each rg In .Range("A2:" & pop)
If rg.Value = IDNum Then

Result = rg.Row
RW = I
Sheets("Sheet" & RW).Activate
Range("A" & Result, "D" & Result).Select
Selection.Copy

Workbooks("Test_A.xls").Worksheets("sheet1").Activate

Range("A25").Select
ActiveSheet.Paste
Range("E15").ClearContents
Range("A1").Select
Workbooks("Test_B.xls").Close


Exit Sub
End If
Next
End With
Next I

Workbooks("Test_A.xls").Worksheets("sheet1").Activate
Range("E15").ClearContents
Range("A1").Select

Workbooks("Test_B.xls").Close

End Sub
---------------
う~ん、中身はあちこちの寄せ集めなので 私には詳しく説明できません。
なんとなくしか解りません。

再び続く

これで最後

次は簡単です。ファイルを閉じるときに Test_A.xlsのシート1の
A25からD25に表示されているデータを消すというだけ。
これはプロジェクトの ThisWorkbookを ダブルクリックしてそこに貼り付けてください。
---------------
Private Sub Workbook_BeforeClose(Cancel As Boolean)

Range("A25:D25").ClearContents

End Sub
---------------
Test_A のシート1に IDを入力後 ダブルクリックすると Test_B を開くようになっていますので
最初から開いておく必要はありません。
また 検索が終わると閉じるようにしています。

私が試した Bのファイルは シートが3枚、データがA2から D列まで ランダムにはいったものを使いましたが
このマクロは Aのシートをダブルクリックして Bを開いたときに シートの枚数を数えて処理しますので 現在7枚だと
書いてありますが 増えても大丈夫なはずです。

もしよろしかったら試してみてください。その際 Bの各々のシートに書き込まれている 住所、氏名などの セルの位置などによって
書き換える必要がありますので、もし不明の点がありましたら また書き込んでください。

とこれが書き込んだ回答、さすがに長すぎるので3回に分割。

一応 HPに このエクセルのファイルを載せようと思っている。
興味のある方は http://www.geocities.jp/pink_v54/

を見てください。(今からページを作ります)
スポンサーサイト

Comment

Comment_form

管理者のみ表示。 | 非公開コメント投稿可能です。

ご案内

プロフィール

みっちゃんα

Author:みっちゃんα
FC2ブログへようこそ!

最近の記事

月別アーカイブ

ブロとも申請フォーム

右サイドメニュー

ブログ内検索

上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。