EXCEL2010VBA　一覧から検索し該当するデータをリストに表示　clickで転記

Question

お世話になっております。マクロは初心者です。
名簿を作成しています。”データ”シートと”名簿”シートがあります。VLOOKUPで名簿シートに名前を入れるとデータシートのデータが反映されるようにしてあります。しかし、これでは同姓同名の方のデータはきちんと反映されないことに気づきました。
そこで、いろいろ調べて、ユーザーフォームを使い、検索してリストに表示するやり方があるのはわかりましたが、どうやったらいいかがわかりません。

　　Ａ　　　Ｂ　　　Ｃ　　　Ｄ・・・ＡＡ
１　名前　・・・・　　　　　　　　　班名
２　
３
・
・
・


と言った形に並んでいて、各列にはその人の情報が入力してあります。
データは1000件以上あります。

名簿の氏名のセルに名前を入力したら、ユーザーフォーム等で同姓同名の方の名前と班名を表示させて、名前をクリックした人の情報が名簿に反映されるようにすることは可能でしょうか？

できれば、解説を付けて教えて頂けると幸いです。

まだまだ勉強を始めたばかりで、コードの内容がよく分かっていません。
勉強のためにもよろしくお願いします。

hallo-2007 · Accepted Answer

>氏名のセルに名前を入力された時点で候補をリストアップし、その中から該当する方を選択してデータを反映させるという形がとりたいのですが、
>ネットで検索すればするほどどういうやり方が一番スマートで確実なやり方なのか全く分からなくなってしまいました。
どう考えても、Vlookup関数を使う以上、名簿のシート変更するしか方法はありません。
別案ですが
　　　　Ａ　　　　Ｂ　　　Ｃ　　　Ｄ・・・ＡB
 １　班名＋名前　名前　・・・・　　　　　　班名
 ２　=AB2&B2
 ３　=AB3&B3
・
 ・
 ・
と作業列を準備（それでも同じ班に同性同名は無と云う事で）
作業員名簿にも班名を入れるセルを準備
作業手順
班名を選択（変更）するとユーザーフォームが起動
名簿から指定した班名の名前一覧がユーザーフォームに表示
名前を選択して、ユーザーフォームを閉じると同じ行の名前の部分に入る。
Vlookup関数は　
=IFERROR(VLOOKUP(班名のセル　＆　E27,データ!$A:$BC,2,FALSE),"")
として、結果に間違いがないようにします。

VBAの問題ではなく、シートの構成、準備の仕方の問題だと思います。
一例ですが、
名簿
　　　　Ａ　　　　Ｂ　　　Ｃ　　　Ｄ・・・ＡB
 １　社員番号　名前　・・・・　　　　　　班名
・・・
作業データ
　　　　Ａ　　　　Ｂ　　　　Ｃ　　　D
 １　作業番号　　社員番号　名前　　班名
 ２　１００１　　A1000　　あいう　A
 ３　１００１　　B1000　　かきく　B
・・・・
と印刷ずる作業番号と社員番号の一覧を入力して管理に使う
印刷する作業員名簿には、作業番号を入れると全ての情報は
表示される様な関数を考えた方が便利ではないでしょうか。

tom04 · Answer

No.1です。

補足の画像を拝見しましたが、小さすぎて詳細が判りません。
VBAの方法をご希望だというコトですので、列・行の配置が判らないことには
コードの考えようがありません。
（仮にコードを記載しても配置が異なれば無意味なものになるため）

セル結合があり、なおかつ
＞VLOOKUPで名簿シートに名前を入れるとデータシートのデータが反映されるようにしてあります。

というコトですが、どのセルにどのような数式が入っているのか？
VLOOKUP関数そのものもかなり厄介なのでは？

直接のアドバイスでないので
ごめんなさいね。m(_ _)m

hallo-2007 · Answer

データの基本ですが、登録番号など重複しない管理の番号を付けるのが
一番良いと思います。
　　Ａ　　　　　Ｂ　　　Ｃ　　　Ｄ　　　・・・ＡB
 １　管理番号　名前　・・・・　　　　　　　　　班名
 ２　A001
 ３　A002
・
 ・
 ・
とかです。
管理番号は、苗字のイニシャル+数値３ケタ　とかしてわかりやすくします。

もし、VBAの勉強と云う事であれば

別シートに登録作業のシートを作って
登録、一行削除、全削除、印刷　とかボタンを配置

登録作業のシートに、管理番号を入力して、正しい名前などを
Vlookup関数で表示させる。
或いは、コンボボックスをシート上に配置して、名前を探す。
選択した名前の行をリンクするセルで指定して表示
あとは、Index関数で他の情報を表示させます。

良ければ、登録ボタンで名簿シートの最後の行に追加
間違った時の為の一行削除
新しく作業をするための全削除
名簿シートを印刷するための印刷ボタン位を配置すれば
使いやすいのではないでしょうか。

ki-aaa · Answer

>申し訳ありません。初心者なもので、このコードをどうすればいいのでしょうか？

これは、エクセルのバージョンによって違います。
検索ワードを書きますので検索してください。
 xxxxはエクセルのバージョン

excelxxxx　マクロブック
excelxxxx　マクロの書く場所
excelxxxx　マクロの実行方法
excelxxxx　vba シートイベント

ki-aaa · Answer

こんにちわ。
同姓同名は稀にしかないと思い、簡便な方法にしました。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim MsgString As String
    Dim i As Long, j As Long, k As Long
    Dim 同名Count As Long
    Dim FindRange As Range
    Dim Ws As Worksheet

If Target.Count <> 1 Then Exit Sub
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    Set Ws = Sheets("Sheet2") 'Set Ws = Sheets("データ")
    同名Count = WorksheetFunction.CountIf(Ws.Range("A:A"), Target.Value)

Select Case 同名Count
    Case 0
        MsgBox "同じ名前がデータにありません"
        Set Ws = Nothing
        Exit Sub
        
    Case 1
        i = WorksheetFunction.Match(Target.Value, Ws.Range("A:A"), 0)
        Application.EnableEvents = False
        Target.Offset(0, 1).Value = Ws.Cells(i, "B")
        Target.Offset(0, 2).Value = Ws.Cells(i, "D")
        Target.Offset(0, 3).Value = Ws.Cells(i, "AA")
        Application.EnableEvents = True
        Set Ws = Nothing
        Exit Sub
        
    Case Else
        Set FindRange = Ws.Range("A:A").Find(what:=Target.Value, LookIn:=xlValues, lookat:=xlWhole)
        For k = 1 To 同名Count
            i = FindRange.Row
            MsgString = Ws.Cells(i, "AA") & "  " & Target.Value & vbCrLf & vbCrLf & _
                        "このデータでよかったら、[はい]を押してください。"
            j = MsgBox(MsgString, vbYesNo + vbQuestion, "同じ名前が " & 同名Count & "件有ります。")
            If j = vbYes Then
                Application.EnableEvents = False
                Target.Offset(0, 1).Value = Ws.Cells(i, "B")
                Target.Offset(0, 2).Value = Ws.Cells(i, "D")
                Target.Offset(0, 3).Value = Ws.Cells(i, "AA")
                Application.EnableEvents = True
                Set Ws = Nothing
                Exit Sub
            End If
            Set FindRange = Ws.Range("A:A").FindNext(after:=FindRange)
        Next k
    End Select
    Set Ws = Nothing
End Sub

tom04 · Answer

こんばんは！なかなか回答が付かないようですので・・・本来であればコード番号等で管理するのが簡単なのですが、質問のような方法もやる気になればできます。しかし相当厄介です。画像や文面だけのやり取りではおそらく伝わらないと思います。（ユーザーフォームの作成方法からの説明になりそうなので）名簿Sheetの表示方法も関数でなくすべてVBAでの操作になりそうです。ただ、これでは何もお役に立てないので別案です。質問を拝見すると「名前」と「班名」が決まれば個人が特定できるようなので、 ↓の画像のように「名簿」Sheetの表示列は「名前」列と「班名」列を近づけそれぞれの列にリスト設定する方法です。尚、作業用としてSheet3を使用しますので、Sheet3は全く使っていない状態にしておいてください。 ①　「データ」Sheetに作業用の列を設けます。画像ではAB2セルに =A2&"_"&AA2 という数式を入れフィルハンドルでずぃ～～～！っと下へこれ以上データはない！という位までコピー！ ②　「名簿」SheetのA列（リスト表示させたいセル）を範囲指定 ③　メニュー　→　データ　→　データの入力規則　→　リスト　→　元の値の欄に =OFFSET(Sheet3!$A$1,1,,COUNTA(Sheet3!A:A)-1) という数式を入れ（この画面からコピー＆ペーストでもOK）　→　エラーメッセージタブの「無効なデータが入力されたら・・・」のチェックを外してOK ④　「班名」のB列を範囲指定　→　データ　→　・・・中略・・・　→　元の値の欄に =OFFSET(Sheet3!C$1,1,,COUNTA(Sheet3!C:C)) という数式を入れOK これでA・B列のリスト設定は完了です。次にVBAのコードになります。「名簿」SheetのSheet見出し上で右クリック　→　コードの表示　→　VBE画面のカーソルが点滅しているところに ↓のコードをコピー＆ペースト　→　Excel画面に戻る（VBE画面を閉じる） Private Sub Worksheet_Change(ByVal Target As Range) '//この行から Dim lastRow As Long, wS As Worksheet Dim myFirst As Range, myFound As Range Set wS = Worksheets("Sheet3") '//←「Sheet3」は作業用のSheetとする If Intersect(Target, Range("A:A")) Is Nothing Or Target.Count > 1 Then Exit Sub If Target <> "" Then wS.Range("A:C").Clear With Worksheets("データ") Set myFound = .Range("A:A").Find(what:=Target, LookIn:=xlValues, lookat:=xlPart) If Not myFound Is Nothing Then wS.Range("B1") = "ダミー" Set myFirst = myFound wS.Cells(Rows.Count, "B").End(xlUp).Offset(1) = myFound wS.Cells(Rows.Count, "C").End(xlUp).Offset(1) = .Cells(myFound.Row, "AA") Do Set myFound = .Range("A:A").FindNext(after:=myFound) If myFound.Address = myFirst.Address Then Exit Do wS.Cells(Rows.Count, "B").End(xlUp).Offset(1) = myFound wS.Cells(Rows.Count, "C").End(xlUp).Offset(1) = .Cells(myFound.Row, "AA") Loop wS.Range("B:B").AdvancedFilter Action:=xlFilterCopy, copytorange:=wS.Range("A1"), unique:=True End If End With Else Target.Offset(, 1).ClearContents End If End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim wS As Worksheet Set wS = Worksheets("Sheet3") If Intersect(Target, Range("B:B")) Is Nothing Or Target.Count > 1 Then Exit Sub With Target If .Offset(, -1) <> "" Then If wS.Cells(Rows.Count, "A").End(xlUp).Row > 2 Then MsgBox "名前を一つだけに絞ってください" .Offset(, -1).Select End If End If End With End Sub '//この行まで最後に「名簿」SheetのC2セルに =IF(COUNTBLANK($A2:$B2),"",INDEX(データ!$A:$AA,MATCH($A2&"_"&$B2,データ!$AB:$AB,0),MATCH(C$1,データ!$1:$1,0))) という数式を入れフィルハンドルで列・行方向にコピー！これで画像のような感じになります。 ※　直接「名前」を入力するというコトのようですので、入力間違いも考慮する必要があると思います。そこで1文字でもA列にデータを入力するとその文字が含まれるデータがリスト候補に表示されるようにし、 A列データが含まれる「班名」をB列のリストとして表示するようにしています。まずはこの程度で・・・m(_ _)m

EXCEL2010VBA 一覧から検索し該当するデータをリストに表示 clickで転記

>氏名のセルに名前を入力された時点で候補をリストアップし、その中から該当する方を選択してデータを反映させるという形がとりたいのですが、

No.1です。

データの基本ですが、登録番号など重複しない管理の番号を付けるのが

>申し訳ありません。

こんにちわ。

こんばんは！

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

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

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

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

EXCEL2010VBA　一覧から検索し該当するデータをリストに表示　clickで転記