Excelにて別シート参照の検索方法

sheet1に写真のような表があって
別シートのA列何行目でも添付画像A列の名前を入力すれば
添付画像B列の情報が表示される。

これを可能にする方法はありますか？

例えばA1に　田中 一郎　と入力
B1～B3まで情報が表示される。

A6に斎藤 次郎を入力
B6～B9まで情報が…のような感じです。

その際情報の列数が4列、5列など人によりけりで
違う場合も対応できるようなものもあった教えていただきたいです。

No.7 ベストアンサー 回答者： GooUserラック 回答日時： 2017/02/23 17:08

複数列対応版です。

-----------------------------------------------------------------------
名前を入力する方のシートモジュールに以下のコードを
･･････････････････････････････････････････････････････････････
Private Sub Worksheet_Change(ByVal Target As Range)
Dim 名前 As String
If Target.Column <> 1 Then Exit Sub
名前 = Trim(Target.Text)
If 名前 = "" Then Exit Sub
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Call データ貼付(ActiveSheet.Name, Target.Row, StrConv(名前, vbWide))
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
-----------------------------------------------------------------------
標準モジュールに以下のコードを
･･････････････････････････････････････････････････････････････
Sub データ貼付(シート As String, 元行 As Long, 名前 As String)
Dim 参照行 As Long
Dim 行 As Long
Dim 列 As Long
Dim 最終列 As Long
With Sheets("Sheet1")
最終列 = .UsedRange.Columns(.Columns.Count).Column
For 参照行 = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
If 名前 = StrConv(Trim(.Cells(参照行, 1).Text), vbWide) Then
行 = 参照行
Do While .Cells(行, 2).Text <> ""
For 列 = 2 To 最終列
Sheets(シート).Cells(元行, 列).Value = .Cells(行, 列).Text
Next
行 = 行 + 1
元行 = 元行 + 1
Loop
Exit Sub
End If
Next
End With
End Sub
-----------------------------------------------------------------------
※ 行がかなり有るという事で多少スピードアップも図っています。（無くても動きます）
①「Application.EnableEvents = False」～「Application.EnableEvents = True」【イベント割り込みを一時停止しています】
②「Application.Calculation = xlCalculationManual」～「Application.Calculation = xlCalculationAutomatic」【自動計算を一時停止しています】
③「Application.ScreenUpdating = False」～「Application.ScreenUpdating = True」【表示書き換えを一時停止しています】

この回答へのお礼

おおおおこれはほんとにすごい！！
ものすごく助かりました！
本当にいろいろとありがとうございました！

お礼日時：2017/02/23 17:27

No.6 回答者： GooUserラック 回答日時： 2017/02/23 12:31

No.5 の追補

意味がうまく伝わっていなかったようなので具体的な図をしめします。

たとえば「斎藤　次郎」と入力したときに黄緑で塗りつぶした部分だけならばほんの少しの改良で出来るのですが、Ｂ列よりＣ列の方が伸びてしまっているので「2012/4/8長男誕生」が反映されません。
完璧にやるとしたら赤枠で囲っている部分（次の名前の行の前まで）をコピーしないといけないのですが、最終データの処理が割と面倒なので、はみ出すデータが無いかの確認がしたかったのです。

この回答へのお礼

あぁ！
はみ出すデータは無いです！
添付して頂いた表で言うと
黄緑の範囲に全て収めるような表にしたいです。

お礼日時：2017/02/23 14:33

No.5 回答者： GooUserラック 回答日時： 2017/02/23 11:04

「もし代入したいセルが増えた場合（C列、D列、E列…）と増えた場合とかも対応はできるのでしょうか？」

このままでは出来ませんが、対応はもちろん可能です。
現状ではＢ列のデータが途切れたところまでとしています。データがどの列もそれより下に伸びていなければ比較的簡単に対応できますがそれで良いのでしょうか？

この回答へのお礼

データは結構多いものを作ろうと思っているので
途切れたところより下まで考えていただければ助かります。
行数でいえば 1000行くらい です。

説明が下手で申し訳ないです…

お礼日時：2017/02/23 12:06

No.4 回答者： GooUserラック 回答日時： 2017/02/21 20:20

マクロ（ＶＢＡ）での回答です。

-----------------------------------------------------------------------
名前を入力する方のシートモジュールに以下のコードを
･･････････････････････････････････････････････････････････････
Private Sub Worksheet_Change(ByVal Target As Range)
Dim 名前 As String
If Target.Column <> 1 Then Exit Sub
名前 = Trim(Target.Text)
If 名前 = "" Then Exit Sub
Call データ貼付(ActiveSheet.Name, Target.Row, StrConv(名前, vbWide))
End Sub
-----------------------------------------------------------------------
標準モジュールに以下のコードを
･･････････････････････････････････････････････････････････････
Sub データ貼付(シート As String, 元行 As Long, 名前 As String)
Dim 参照行 As Long
Dim 行 As Long
With Sheets("Sheet1")
For 参照行 = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
If 名前 = StrConv(Trim(.Cells(参照行, 1).Text), vbWide) Then
行 = 参照行
Do While .Cells(行, 2).Text <> ""
Sheets(シート).Cells(元行, 2).Value = .Cells(行, 2).Text
行 = 行 + 1
元行 = 元行 + 1
Loop
Exit Sub
End If
Next
End With
End Sub
-----------------------------------------------------------------------
※ 対象のシートモジュールへのコード記入はプロジェクトの対象のシートをクリックして開いた所に記入して下さい。標準モジュールではありません。
※ 苗字と名前の間のスペースが全角であったり半角であったりしそうなので、一度全角にした上で比較しています。（半角・全角は気にしなくて良くなっています）

この回答へのお礼

おおおお！
これはすごい！！
やりたかったことそのままです！
教えていただきありがとうございます。

わがままを言うのですが、もし代入したいセルが増えた場合（C列、D列、E列…）と
増えた場合とかも対応はできるのでしょうか？

教えて頂けたら助かります…

お礼日時：2017/02/23 10:44

No.3 回答者： yuji3690 回答日時： 2017/02/21 18:13

まず作業列をCに作ります。

あと1行目は空けておいてください。
また、表示されたデータの最終行の次は空白行にしてください。
つまりA2で検索した結果がB2~B4に表示された場合、A5は空白とし、
A6以降で次の検索。

C2=IF(A2="",IF(B2="","",C1+1),MATCH(A2,sheet1!A:A,FALSE)+1)
これにより、A2およびB2が空白であれば空白、
A2は空白でB2にデータがある場合、上のセルに1加えたものを表示、
A2自体にデータが入力されている場合、「sheet1のA列で該当する行番号に1加えたもの」を表示。

B2=IF(C1="",IF(A2="","",VLOOKUP(A2,sheet1!A:B,2,FALSE)),IF(INDIRECT("sheet1!B"&C1)="","",INDIRECT("sheet1!B"&C1)))
これにより
C1とA2が空白なら空白、
C1は空白（つまり上の行にはデータが無い）で、A2が空白でない（つまり検索データが入力された）場合、A2をsheet1のA列で検索し、該当した行のB列のデータを表示する。
C1自体にデータがある（つまり上の行には何かしら検索データが表示されている)場合、
sheet1のB列で「行番号がC1に表示されている数字」のセルにあるデータを表示する。
(該当セルのデータが空白の場合0となるので、IF(~="","",~)として、空白の場合も空白にしている）

これらB,Cを必要な行数コピーする。

A2が「鈴木 三郎」の場合で確かめると、
B2はC1が空白で、A2は空白ではないので、A2を検索し、B列の「山梨県出身」と表示する。
C2はA2が空白ではないので、A2の位置を検索し、9+1＝「10」と表示する。
B3はC2が空白ではないので、C2に表示された10により、B10の「23歳」と表示する。
C3はA3が空白で、B3は空白ではないので、C2に表示された10に1加え、「11」と表示する。
B4は同様にB11の「バツイチ」と表示する。
C4は同様に11に1加え「12」と表示する。
B5は同様にB12だが、空白なので空白とする。
C5はA5もB5も空白なので、空白とする。
B6はC5が空白なので、A6にデータがあれば検索し、なければ空白とする。
…
といった流れになります。

No.2 回答者： GooUserラック 回答日時： 2017/02/21 15:19

すみません。

1つ回答いただいていないのですが
「表示」とは次のどれでしょうか？
①「sheet1」に切り替えて他のデータを非表示にする。
② 該当のデータを入力したセルの右側に代入する。
③「MsgBox」等を使って表示だけする。
④ その他（具体的な方法を教えてください）

この回答へのお礼

あぁ申し訳ないです…
②でお願いします。

お礼日時：2017/02/21 15:46

No.1 回答者： GooUserラック 回答日時： 2017/02/21 14:31

マクロ（ＶＢＡ）などを使っても良いのでしょうか？

「表示」とは、Ｂ列のデータを貼り付けたほうが良いのでしょうか？
また、同姓同名が有った場合はどうするのでしょうか？

この回答へのお礼

お礼に書いていいのかわからいのですが、
VBAでできるのならそのやり方を教えていただきたいです。
同姓同名はない前提でお願いしたいです。

お礼日時：2017/02/21 14:45