Excel - 検索と表示クエリ

問題

私はITの専門家ではありません。私は簡単な要件を持っていますが、どのようにしたらよいのかわかりません。

要件は

 私のデータ Snoリリースプロジェクト担当者4月1日SYL Sam、Mark、Tom 2 5月Xim Tom、Frank、Kim 3 6月TIG Kim、David、Sam

私が必要とするのは、プロジェクトまたはリリースごとに検索する場合です。連絡担当者名ですべて検索する必要があります。上記の例ではSamなどのように表示されます。 Samがリリースなどの関連データすべてに関わっていたすべてのプロジェクト...これは、Excelの新しいシートに表示される必要があります。

Excelで実行することは可能ですか、それとも他の方法で試す必要がありますか？あなたは私がこれをするのを手伝ってくれる？

溶液

仮定：

1.データが "Sheet1"であるシートの名前（正しくない場合はコードを修正する）
2.検索結果が貼り付けられるシートの名前が「結果」です（コードが正しくない場合は修正してください）。
3.以前の検索結果は破棄されます
4.データは4列にあります（サンプルのように）

ステップ：

1.前提条件を読む
2.バックアップをとる
3. Alt + F11キーを同時に押してVBE環境に入ります。
4. [挿入]をクリックして新しいモジュールを追加します
5.コードを貼り付けます（指示の後に）
6.コードを実行する

コード：

 Sub SearchData（）Dim lMaxRows As Long '列で使用されているセルに基づくデータの最大行数' Dim lFilterRows As Long '最後にフィルタリングされた行Dim searchRel As Variant'何を検索するのかリリース情報Dim searchProj As Variant 'とはプロジェクト情報の検索Dim searchPpl As Variant '連絡先の検索Dim sDataSheet As String'データシートの名前Dim sResultSheet As String '結果シートの名前sDataSheet = "Sheet1"'データシートの名前sResultSheet = "結果"結果シートの名前 '検索条件を取得しますsearchRel = InputBox（ "検索したいリリース。スキップするには、OKを押してください。"）searchProj = InputBox（ "検索したいプロジェクト。スキップするには"）searchPpl = InputBox（"検索したい連絡担当者。スキップするには、単にOKを押してください。 "） '空白を削除するsearchRel = Trim（searchRel）searchProj = Trim（searchProj）searchPpl = Trim（searchPpl '' 3つすべての検索条件が空白の場合は、何もしないでください（Len（searchRel＆ SearchProj＆searchPpl）= 0）エラーが発生したらSubを終了します。次のApplication.DisplayAlerts = Falseが存在する場合は、前の結果シートを削除します。DeleteApplication.DisplayAlerts = TrueがエラーGoTo 0の場合は、結果シートSheets.Addを削除しますActiveSheet.Name = sResultSheet Sheets（sDataSheet）.Select Cells.Select 'エラーが発生した場合ActiveSheet.AutoFilterModeエラーが発生した場合次のActiveSheet.ShowAllDataエラーが発生した場合GoTo 0 lMaxRows = Cells（Rows.Count、 "A"）の場合は終了ActiveSheet.AutoFilterMode = Falseの場合Selection.AutoFilter If If（searchRel） ""の場合Selection.AutoFilterフィールド：= 2、Criteria1：= "="＆searchRel、Operator：= xlAnd、Criteria2：= "（xlUp） "If If If（searchProj）" "Then Selection.AutoFilterフィールド：= 3、Criteria1：=" = "＆searchProj、Operator：= xlAnd、Criteria2：=" "If If If（searchPpl）"その後Selection.AutoFilterフィールド：= 4、Criteria1：= "= *"＆searchPpl＆ "*"、演算子：= xlAnd、Criteria2：= "" lFilterRows = Cells（Rows.Count、 "A"）の場合は終了End（xlUp）.Row Range （ "A1：D" ＆lFilterRows）。コピーシート（sResultSheet）。範囲の選択（ "A1"）ActiveSheet.Paste Sheets（sDataSheet）を選択します。セルを選択します。ActiveSheet.AutoFilterModeの場合、フィルタを削除します。 0サブの場合は終了