【Excel】 名簿から抽出したい。

質問

こんにちは

sheet1に住所録があります。

sheet1
名前　　　　住所
アイウエオ　東京都...
カキクケコ　大阪府...
サシスセソ　愛知県...
・ ・
・ ・
・ ・
・ ・

sheet2に名前と日付のリストがあります。

sheet2
名前　　　　日付
アイウエオ　10/2
サシスセソ　10/3
マミムメモ　10/4
カキクケコ 10/2
ラリルレロ 10/1
・ ・
・ ・

sheet3にはsheet2の日付が今日の人のみの住所録を
表示したいのですが、sheet3の式はどのようになるでしょうか。

sheet3
名前　　　　住所
アイウエオ　東京都...
カキクケコ　大阪府...

宜しくお願いいたします。

回答No.1

KenKen_SP · ベストアンサー

こんにちは。KenKen_SP です。

計算式では無理では、、、

ゴリゴリロジックで VBA コードを書いてみました。Sheet3 をアクティブ
にすると自動でデータの抽出を行います。念のため「更新許可」を尋ねる
仕組みにしておきました。

ただ、小規模データの場合は問題ないと思いますが、大規模になると処理
スピードは遅いですね。サンプルデータ1万件で動作確認を行いましたが、
転記処理よりも今日の日付と該当するデータを探す処理（Findメソッド）
でえらく時間がかかります。

注意事項として、Sheet3 の名前は変更しても差し支えありませんが、
Sheet1 および Sheet2 の名前を変更した場合、コードの修正が必要です。

【手順】
1.　シート選択タブ上でSheet3 を選択し、右クリック[コードの表示]
2.　Visual Basic Editor（以下VBE）が起動
3.　VBE 上に以下のコードをコピー＆ペースト
4.　VBE 閉じる
5.　一度他のシートをアクティブにし、再度 Sheet3 をアクティブにして
　　コードが実行されることを確認

'以下終わりまでコード

Option Explicit

Private Sub Worksheet_Activate()

　　Const cstBufSize As Long = 500

　　Dim SH　　 As Worksheet
　　Dim rngDat As Range
　　Dim rngCel As Range
　　Dim rngFnd As Range
　　Dim Buf()　As String
　　Dim i　　　As Long
　　Dim j　　　As Long
　　Dim lngR　 As Long

　　If MsgBox(Format$(Date, "yyyy/mm/dd") & " のデータで更新しますか？", _
　　　　vbOKCancel Or vbDefaultButton2 Or vbInformation) = vbCancel Then
　　　　Exit Sub
　　End If

　　'初期化
　　Application.ScreenUpdating = False
　　Me.Cells.Clear
　　lngR = 2
　　ReDim Buf(cstBufSize)

　　On Error GoTo Terminate

　　'Sheet2 から今日の日付データをもつ行の名前を抽出
　　Set SH = ThisWorkbook.Sheets("Sheet2")
　　Set rngDat = Intersect(SH.UsedRange, SH.Columns(2))
　　For Each rngCel In rngDat
　　　　With rngCel
　　　　　　If Not IsEmpty(.Value) Or _
　　　　　　　 Not IsDate(.Value) Then
　　　　　　　　If .Value = Date Then
　　　　　　　　　　Buf(i) = .Offset(0, -1).Value
　　　　　　　　　　i = i + 1: j = j + 1
　　　　　　　　　　If j = cstBufSize Then
　　　　　　　　　　　　ReDim Preserve Buf(i + cstBufSize)
　　　　　　　　　　　　j = 0
　　　　　　　　　　End If
　　　　　　　　End If
　　　　　　End If
　　　　End With
　　Next rngCel
　　ReDim Preserve Buf(i - 1)

　　'Sheet1 から抽出した氏名の行を Sheet3 へコピー
　　Set SH = ThisWorkbook.Sheets("Sheet1")
　　Set rngDat = Intersect(SH.UsedRange, SH.Columns(1))
　　SH.Rows(1).Copy Destination:=Me.Rows(1) '見出しコピー
　　For i = 0 To UBound(Buf)
　　　　If Buf(i) <> "" Then
　　　　　　Set rngFnd = rngDat.Find( _
　　　　　　　　What:=Buf(i), _
　　　　　　　　LookIn:=xlValues, _
　　　　　　　　LookAt:=xlWhole)
　　　　　　If Not rngFnd Is Nothing Then
　　　　　　　　rngFnd.EntireRow.Copy Destination:=Me.Rows(lngR)
　　　　　　Else
　　　　　　　　Me.Cells(lngR, 1).Value = Buf(i)
　　　　　　　　Me.Cells(lngR, 2).Value = "No Data"
　　　　　　End If
　　　　　　lngR = lngR + 1
　　　　　　Set rngFnd = Nothing
　　　　End If
　　Next i
　　Erase Buf

Terminate:
　　Application.ScreenUpdating = True
　　If lngR = 2 Then
　　　　MsgBox "該当データはありません", vbInformation
　　End If
　　Set rngDat = Nothing
　　Set rngCel = Nothing
　　Dim SH = Nothing

End Sub

回答No.4

goowon

Vlookup関数を使います。

sheet1
行番号　　　A列　　　　　B列
1　　　　　名前　　　　住所
2　　　　　アイウエオ　東京都...
3　　　　　カキクケコ　大阪府...
4　　　　　・　　　　　　・
5　　　　　・　　　　　　・
・　　　　　・　　　　　　・
sheet2
行番号　　A列　　　　　B列
1　　　　　日付　　　　名前　
2　　　　　10/2　　　アイウエオ　　
3　　　　　10/3　　　サシスセソ　　
4　　　　　・　　　　　　・
5　　　　　・　　　　　　・
・　　　　　・　　　　　　・
日付を名前の前列に配置します。

以上改訂して

sheet3
行番号　A列　　　　　　　B列
1　　　10/2←求める日付入力　
2　　　　名前　　　　 　住所
3　　　アイウエオ　　　東京都...
4　　　　　・　　　　　　・
5　　　　　・　　　　　　・
6　　　　　・　　　　　　・

A1に10/2を入力すると名前住所が出力されます。

A3の式
=VLOOKUP($A$1,Sheet2!$A$2:$C$100,2,)
B3の式
=VLOOKUP(A3,Sheet1!$A$2:$C$100,2,)

$C$100・・・検索範囲の行数です。
$・・・コピーするときに検索範囲が変わらないためです。
シート枚数はできるだけ少なくした方がいいと思います。

回答No.3

imogasi

下記でどうですか（imogasi方式）
氏名は同姓同名があれば山田太郎2のように区別してください。
例データ
Sheet1のA1:B１０
氏名 住所
山田 江東区
小島 佐倉市
大田 川口市
大島 杉並区
大山 船橋市
小山 千葉市
大川 八王子市
小川 三鷹市
木村 文京区
Sheet2のA1:B10
A列　　　B列　　　　　　　　D列
10月1日
山田 10月1日 1
小島 10月2日 1
大田 10月1日 2
大島 10月4日 2
大山 10月5日 2
小山 10月1日 3
大川 10月2日 3
小川 10月1日 4
木村 10月9日 4
A1は抜き出す日を入力します。=TODAY()でも可。
D2に
=COUNTIF($B$2:B2,$B$1)
と入れて、D10まで式を複写する。
結果は上記D列の通り。
Sheet3に行き
A1に
=INDEX(Sheet2!$A$2:$B$10,MATCH(ROW(),Sheet2!$D$1:$D$10,0)-1,1)
と入れて、A4まで式を複写。
B1に
=VLOOKUP(A1,Sheet1!$A$2:$B$10,2,FALSE)
と入れて、B4まで式を複写。
丁寧にすればA1は
=IF(ROW()>MAX(Sheet2!$D$1:$D$10),"",INDEX(Sheet2!$A$2:$B$10,MATCH(ROW(),Sheet2!$D$1:$D$10,0)-1,1))
と入れて、適当行まで式を複写
B1は
=IF(A1="","",VLOOKUP(A1,Sheet1!$A$2:$B$10,2,FALSE))
と入れて、適当行まで式を複写。
結果
山田 江東区
大田 川口市
小山 千葉市
小川 三鷹市

回答No.2

kitoomo

Sheet1のA列に名前、B列に住所、
Sheet2のA列に名前、B列に日付があるものとします。
ふくざつになるのでSheet2のC,D,E列に以下のように式を分けます。

C列2行目以降に
=IF(B2=TODAY(),A2,"")
として今日の日付に該当する名前を抽出します。

D列2行目以降に(99はリストの行数より大きな数とします）
=IF(C2=A2,MATCH(C2,A$2:A$10,0),99)
として抽出した名前が何番目かを表します。

E列2行目以降に
=SMALL(D$2:D$10,ROWS(D$2:D2))
として行の若い順に並べ替えます。

Sheet3のA列には
=IF(Sheet2!E2<99,OFFSET(Sheet2!A$1,Sheet2!E2,0),"")
としてSheet2で抽出した名前が
Sheet3のB列には
=IF(A2="","",OFFSET(Sheet1!B$1,MATCH(A2,Sheet1!A$2:Sheet1!A$10,0),0))
としてA列の名前に対応したSheet1の住所が表示できます。