エクセルvbaで同姓同名の抽出方法について

質問

エクセルVBAで質問があります。
ワークシート１(上段、example1)のＢ２のセルにひらがな（苗字）を入力したとき、ワークシート２(下段、example2)で作成して該当した情報をワークシート１のＣ２からe7へ反映させたいと考えています。
ワークシート2に、1000人越えの情報があり、かつ、同姓同名が何人かいて、フィルタをかけてもフィルタ結果後から目的の人を見つけるのが大変なんです。
入力したコードは、下記の通りなのですが、どこをどう直せばいいのか分かりません。どなたか教えていただけないでしょうか？

Sub sample()
Dim i As Byte
  i = 1
  If < Worksheets("example2!A2:A9").Value > = 5 Then
        Worksheets(i + 4, "example2!C2:E2").Value = EntireRow("example2!D:F").EntireRow = True
   ElseIf 4 < Worksheets(i + 3, "example2!A2:A9").Value > = 4 Then
        Range.Worksheets("example1!C3:E3").Value = EntireRow("example2!D:F").EntireRow = True
   ElseIf 3 < Worksheets(i + 2, "example2!A2:A9").Value > = 3 Then
        Range.Worksheets("example1!C4:E4").Value = EntireRow("example2!D:F").EntireRow = True
   ElseIf 2 < Worksheets(i + 1, "example2!A2:A9").Value > = 2 Then
        Range.Worksheets("example1!C5:E5").Value = EntireRow("example2!D:F").EntireRow = True
   ElseIf 1 < Worksheets(i + 0, "example2!A2:A9").Value > = 1 Then
        Range.Worksheets("example1!C6:E6").Value = EntireRow("example2!D:F").EntireRow = True
   ElseIf 0 < Worksheets(i + -1, "example2!A2:A9").Value > = 0 Then
        Range.Worksheets("example1!C7:E7").Value = EntireRow("example2!D:F").EntireRow = True
Else
End If
      Range("example1!B2").Value = " "
End sub

回答No.3

tsubu-yuki

色々と考えさせられるモノですねぇ・・
ご提示のソレは何を参考に書かれたものなのでしょう。
なかなか見かけない文法ばかりで、
> どこをどう直せばいいのか
私も解りません(笑)。
根本的に考え直したらいかがか？としか言いようがありません。
ご自身がやりたい処理をまとめませんか？

まぁ、マクロ以前の問題だと思うのです。
私の予想に過ぎないのですが、
「フィルタをかけて、結果をコピー、別シートに貼り付け」
の処理と大差ないのではないでしょうか。
だとしたら、それを「マクロの記録」してやれば
大体いい感じのコードを書けます。
あとはご自身の使いやすくカスタマイズしてやればいいだけです。

> 1000人越えの情報があり、
>同姓同名が何人かいて、フィルタをかけても
> フィルタ結果後から目的の人を見つけるのが大変
1000人を超える「同姓同名」が居るではないですよね？
「同姓」に限っても多くて十数名でしょう。
エクセルを最大化しておけば３０～５０行は画面に表示されますから
普通にフィルタをかければスクロールせずに１画面に十分納まるのでは？

見た感じ、
・みょうじ（昇順）
・社員コード順（昇順）
にでも並んでいるんですかねぇ。
これを変えてみたらいかがですか？
考えやすいのは
・みょうじ（昇順）
・なまえ（昇順）
・※部署（昇順）
でしょうか。
フィルタの結果が何件あろうが名前が五十音で並び、
さらに部署ごとに並ぶのですから、
ここにフィルタを掛ければ、さらに探しやすくなるのでは？
これで探せない、とおっしゃるのであれば、それはそれ、
「国語辞書、引けます？」という疑問を禁じ得ないところです。

回答No.2

imogasi

＞フィルタをかけてもフィルタ結果後から目的の人を見つけるのが大変なんです。
質問の例の内容を質問者が換骨脱胎したのか。普通では、氏名では、ひらがな読みにしても、そんなに探しにくいほどの数にはならないだろう。
会社のややっていることを隠したいなら、要点を外さずよく考えて例を作って質問すること。
例に挙げているコードも、昨日今日マクロを始めた人の、コードではないか。こんなものを挙げて読者に長々と読ませないで、したいことの説明文章をしっかり書いて、回答者に任せたら。
IF文が３つ以上になったら、ほかに良い方法（仕組み）がないか勉強するべきだ。
どういうロジックでやるべきかアドバイスを受けたらどうか。
（１）行を総なめして、ＩＦで聞く
（２）エクセルフィルタ機能利用
（３）ＲａｎｇｅのＦｉｎｄメソッドを利用
（４）その他　VBSCRIPTのＤｉｃｔｉｏｎａｒｙやADOのSQL利用や　　　　　　　そのほかの手法
ーー
フィルタでやって、あるいはFindでやってどういう困難にぶつかったのか？
ーー
ややこしそうなのは、カナの読みや（区切りの）スペースの入れ具合、など難しい点（索引する表の氏と名と、入力データのそれ、で）はないのか（例　なかがわ　と　なかかわ、など（濁点有無）。）
画像例でも姓と名の間のスペースの数が不揃いなようだ、というか姓と名を
別列に分けると絞るのは難しくなるのでは。
姓と名の結合したデータ（間１スペース）をワーク列に作って、そこを使ったら。
こういうのは、コーディング以前のデータ設計の問題だよ。
ーー
一回操作ごとに検索結果を見るだけで、使い捨てするのか。ならばシートに表示するのは、不便な点があるのでは。勉強が進んだら、ユーザーフォームのようなものを使うような気がする。
＞Dim i As Byte
はあまり見かけない定義だが、確信はあるの。

回答No.1

real beatin（@realbeatin）

こんにちは。

落ち着いて、状況を整理し、何が必要か、要点は何か、
ご自分の中で普通の言葉として整理することが大切です。
初心者もベテランも関係なく、それを日々実践なければ、
マクロを扱うことも自分でむずしくしてしまうことになります。
VBAを扱うということは、Excelの一般機能を十分に習熟した上で、
Excelの一般機能だけでは不足がある場合を前提に考えた方がいいです。
今回のようなケースでも、Excelの一般機能で何を使えば出来るのだろう？
ということを、真っ先に探ってみることが問題解決への近道になります。
急いでも急がなくても、勉強したこと、身に付いたこと、でしか、
安心して扱うことはむずしいですから、
自分に出来ることの中から、なるべく簡単な方法を選んで、
実現する、ように心がけてください。
マクロ（Excel VBA）を覚えていくのなら、
何度でも何度でも、
Excelの一般機能のお浚い、VBA基本事項のお浚い、を続けることを
お忘れなきよう。

以下、主に添付画像から想定される要求に応えるVBAコードです。
Excelの一般機能の[フィルター]=.AutoFilterを使っています。
VBAに関する一般論として、
何をしたいかという要求は無数にあって、
それをどう実現するかという方法も無数にあります。
お示しするのは、たぶん、数億通りの中の一例、みたいなものです。
どんな要求にでも応えられる万能なものは、この世にありませんから、
もし求める結果を得られなかったなら、
ご自身で解決する道をまず探ってみて、難しいようでしたら、
要点を整理し直して、新しい質問に繋げてください。

　[example1] のシートタブを右クリック
　[コードの表示] をクリック
　表示されたVBエディタ【ブック名 - [SheetX（コード）]】に以下を貼付け

' ' === [example1]のシートモジュール
' ' // [みょうじ] を 入力したら、【姓が同音】の社員データを抽出する
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Text = "" Then Exit Sub
Select Case Target.Address(0, 0)
Case "B2"　'　【[B2] に [みょうじ] を 入力したら】以下の処理実行　？　"B2"
　　Range("C2:F8").ClearContents　'　【抽出データの出力先】を指定　？　"C2:F8"
　　With Sheets("example2")　'　【基テーブルのシート名】を指定　？　"example2"
　　　　If .FilterMode Then .ShowAllData
　　　　.Cells.AutoFilter _
　　　　　　Field:=2, Criteria1:=Trim$(Target.Text)　'　【基テーブルの[みょうじ]列位置】を指定　？　2
　　　　.AutoFilter.Range.Columns("D:F").Offset(1).Copy　'　【基テーブルの[抽出項目]列位置】を指定　？　"D:F"
　　　　Application.EnableEvents = False
　　　　Range("C2").PasteSpecial xlPasteValues　'　【抽出データの出力先先頭セル】を指定　？　"C2"
　　　　Application.EnableEvents = True
　　　　.ShowAllData
　　End With
　　Application.CutCopyMode = False
　　If WorksheetFunction.CountA(Range("C2:C8")) = 0 Then MsgBox "該当なし"　'　【抽出データの出力先１列め】を指定　？　"C2:C8"
End Select
End Sub
' ' ===

注意点
１）　[example1] の [みょうじ入力セル] には
　　 [セルの結合] は適用できません。
　　→上記では、機能しなくなります。
２）　> ひらがな（苗字）を入力したとき、
　　「入力を確定した時」でなければ、
　　VBAではどうやっても手出し出来ませんので、誤解のないよう。
３）　シート名、セル範囲の参照については、
　　７か所、"？"マークで指示してあります。
　　変更や確認は、そちらでお願いします。