エクセルで2つのシートに同じ名前があれば印をつける

質問

シート１はイベント参加者名、シート２は注文者です。
どのイベントに参加した人が注文しているか調べたいのです。
注文者シートの氏名列にイベント参加者と同じ名前があれば、印をつけたいと思います。

イベント参加者のシートは
　　　Ａ　　　　　　　　　　Ｂ　　
会場番号　　　　　　　氏　名

一人の人が何回もイベントに参加している場合は想定していません。

別シートに抜き出すのではなく、注文者シートに列を追加してそこに会場番号が表示されたらすごくうれしいです。
どうぞよろしくお願いします。

回答No.2

KURUMITO · ベストアンサー

シート２のA列に注文者の名前が有るとして。例えばC1セルに次の式を入力して下方にドラッグコピーすることでシート１に同じ名前の参加者が有る場合にその方の会場番号を表示します。

=IF(OR(A1="",COUNTIF(Sheet1!B:B,A1)=0),"",INDEX(Sheet1!A:A,MATCH(A1,Sheet1!B:B,0)))

印をつけるとの作業は上の作業で良いのでしょうか。
シート１のB列の名前がシート２の注文者の名前と一致すればシート１のC列に○などの表示をさせるのでしたらシート１のC１セルには次の式を入力して下方にドラッグコピーします。

=IF(COUNTIF(Sheet2!A:A,B1)=0,"","○")

=

お礼

助かりました。○印をつけるより、会場番号を表示させた方がありがたかったので、上の方法で処理しました。多くのデータがあったので困ってましたが、解決しました。ありがとうございました。

回答No.3

K Kazz（@JazzCorp）

'マッチングプしたデータをマークして指定された列をコピー
Option Explicit
Sub MakingCells()
Const xFrom = "Sheet1" 'データ元
Const xTo = "Sheet2" 'コピー先
Const xSign = "印" 'マーキング
Const xKey_From = "B" 'キー列データ元
Const xKey_To = "A" 'キー列コピー先
Const xPick_From = "A" 'コピー列データ元
Const xPick_To = "E" 'コピー列コピー先
Const xHeads = 1 'ヘッダ行数
Dim kk As Long
Dim nn As Long
Dim xSheet_From As Worksheet
Dim xSheet_To As Worksheet
Dim xLast_From As Long
Dim xLast_To As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set xSheet_From = Sheets(xFrom)
Set xSheet_To = Sheets(xTo)
xSheet_To.Columns(xPick_To).Clear
'最終行チェック
xLast_From = xSheet_From.Cells(Rows.Count, xKey_From).End(xlUp).Row
xLast_To = xSheet_To.Cells(Rows.Count, xKey_To).End(xlUp).Row

For kk = 1 + xHeads To xLast_To
If (xSheet_To.Cells(kk, xKey_To) <> Empty) Then

For nn = 1 + xHeads To xLast_From
If (xSheet_From.Cells(nn, xKey_From) <> Empty) Then

If (xSheet_To.Cells(kk, xKey_To) = xSheet_From.Cells(nn, xKey_From)) Then
'xSheet_To.Cells(kk, xKey_To) = xSheet_To.Cells(kk, xKey_To) & xSign
xSheet_To.Cells(kk, xKey_To) = xSheet_From.Cells(nn, xKey_From) & xSign
xSheet_To.Cells(kk, xPick_To) = xSheet_From.Cells(nn, xPick_From)
End If
End If
Next nn
End If
Next kk

Epilogue:
xSheet_To.Select
Application.CutCopyMode = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

回答No.1

aokii

Sheet1のC2セルに以下の式を貼り付けて、下にドラッグコピーし、
=A2

（Sheet2のA2セルから下に注文者の指名が記載されているとした場合）
Sheet2のB2セルに以下の式を貼り付けて、下にドラッグコピーしてみてください。
=VLOOKUP(A2,Sheet1!B:C,2,FALSE)