エクセル 検索したい項目だけリストアップ

質問

こんにちは質問です。

仕事でいきずまってます。エクセルのスペシャリスト様、ご教授願います。

3人の担当者のsheet（ああ、いい、うう）があり、工場名、工事名称、担当者が記入してあります。

１、集計シートの検索欄に工場名を入力したら、
　　3人の担当者sheetにあるデータと一致する工場名の行を表示させたいです。

２、担当者の名称を入力したら、その担当の工事をすべて表示したいです。

３、工場名および担当者名を入力したら
　　3人の担当者sheetにあるデータと一致する工場名及び担当者の行を表示させたいです。

すべてを網羅できますでしょうか？

マクロは苦手です。関数でなんとかなりませんか？

回答No.2

kagakusuki · ベストアンサー

まず、各「担当者のSheet」のシート名を、担当者名と同じ名称となる様にして下さい。
　次に、新しいシートを1枚設けて、そのシート名を

作業用

等として下さい。
　次に、作業用シートのA1セルからC1セルにかけて、各「担当者のSheet」の"シート名"を入力して下さい。
　次に、作業用シートのA2セルに次の様な関数を入力して下さい。

=IF(ISREF(INDIRECT("'"&A$1&"'!A1")),IF(IF(集計!$B$2="",集計!$B$3=A$1,AND(OR(集計!$B$3="",集計!$B$3=A$1),INDIRECT("'"&A$1&"'!A"&ROW())=集計!$B$2)),COLUMNS($A:A)*10000000+ROW(),""),"")

　次に、作業用シートのA2セルをコピーして、作業用シートのB2～C2の範囲に貼り付けて下さい。
　次に、作業用シートのA2～C2の範囲をコピーして、同じ列範囲の3行目以下に貼り付けて下さい。

　次に、集計シートのA7セルに次の様な関数を入力して下さい。

=IF(ROWS($7:7)>COUNT(作業用!$A:$C),"",IF(INDEX(INDIRECT("'"&INDEX(作業用!$A$1:$C$1,INT(SMALL(作業用!$A:$C,ROWS($7:7))/10000000))&"'!A:C"),MOD(SMALL(作業用!$A:$C,ROWS($7:7)),10000000),COLUMNS($A:A))="","",INDEX(INDIRECT("'"&INDEX(作業用!$A$1:$C$1,INT(SMALL(作業用!$A:$C,ROWS($7:7))/10000000))&"'!A:C"),MOD(SMALL(作業用!$A:$C,ROWS($7:7)),10000000),COLUMNS($A:A))))

　次に、集計シートのA7セルをコピーして、集計シートのB7～C7の範囲に貼り付けて下さい。
　次に、集計シートのA7～C7の範囲をコピーして、同じ列範囲の8行目以下に貼り付けて下さい。

　以上で準備は完了で、後は集計シートのB2セルに工場名や担当者名を入力しますと、集計シートのA列～C列の7行目以下に、3人の担当者シートにあるデータの中で、該当する全てのデータが表示されます。

お礼

ご丁寧にらありがとうございました。
チャレンジしてみます。

回答No.3

tom04

こんばんは！

関数でやってみようと作業用の列・Sheetを使用して試みましたが
数式が長くなるのであきらめました。

お望みでないVBAになってしまいますが、一例です。
↓の画像の左側が「集計Sheet」でSheet見出しの一番左側にあり、Sheet2～Sheet4のSheet名は
ああ・いい・うう　のように担当者名になっているという前提です。

まず、Alt＋F11キー　→　メニュー　→　挿入　→　標準モジュール　→　VBE画面に
↓のコードをコピー＆ペーストしてください。

Dim k As Long, lastRow As Long, str As String, wS As Worksheet 'この行から
Sub Sample1()
Set wS = Worksheets(1)
For k = 2 To 4 '←Sheet見出しの左から2番目～4番目のSheet
With Worksheets(k)
.Range("A1").AutoFilter field:=1, Criteria1:=wS.Range("B2")
If wS.Range("B3") <> "" Then
.Range("A1").AutoFilter field:=3, Criteria1:=wS.Range("B3")
End If
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
If lastRow > 1 Then
Range(.Cells(2, "A"), .Cells(lastRow, "C")).Copy wS.Cells(Rows.Count, "A").End(xlUp).Offset(1)
End If
.AutoFilterMode = False
End With
Next k
End Sub

Sub Sample2()
Set wS = Worksheets(1)
str = wS.Range("B3")
On Error Resume Next
With Worksheets(str)
If wS.Range("B2") <> "" Then
.Range("A1").AutoFilter field:=1, Criteria1:=wS.Range("B2")
End If
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
If lastRow > 1 Then
Range(.Cells(2, "A"), .Cells(lastRow, "C")).Copy wS.Cells(Rows.Count, "A").End(xlUp).Offset(1)
End If
.AutoFilterMode = False
End With
End Sub 'この行まで

次にExcel画面に戻り、
Sheet見出しの一番左側にある「集計Sheet」のSheet見出し上で右クリック　→　コードの表示　→　VBE画面に
↓のコードをコピー＆ペースト　→　Excel画面に戻り、B2・B3セルにデータを入力してみてください。

Private Sub Worksheet_Change(ByVal Target As Range) 'この行から
Dim endRow As Long
If Intersect(Target, Range("B2:B3")) Is Nothing Then Exit Sub
endRow = Cells(Rows.Count, "A").End(xlUp).Row
If endRow > 6 Then
Range(Cells(7, "A"), Cells(endRow, "C")).ClearContents
End If
If Target.Address = "$B$2" Then
If Target <> "" Then
Call Sample1
Else
Call Sample2
End If
ElseIf Target.Address = "$B$3" Then
If Target <> "" Then
Call Sample2
Else
Call Sample1
End If
End If
End Sub 'この行まで

おそらくお望み通りの動きになると思います。

＞マクロは苦手です。関数でなんとかなりませんか？
というコトですので、
ご希望の方法でない場合は無視してください。m(_ _)m

回答No.1

marimo44

ピボットテーブルでできると思いますよ。

補足

やりかたがよくわかりません。
できましたら、やり方を教えて下さい。
素人なもので。
関数でなんとかなりませんか？