特定の文字列が含まれている行のみ抜き出して、別シートに書き出す方法（Excel 2007）

Sheet1のA列に特定の文字列が含まれている行のみ（列はAだけでなくCまで続きます）を抜き出して、Sheet2に書き出すにはどうすればよいでしょうか。行が1,000行以上あり、とても手作業では無理です。バージョンはExcel 2007です。できるだけ詳しくお願いします。

添付画像左側が、作業開始前のSheet1です。右側が完成後のSheet2です。A列に文字列「JP」を含む行だけを抜き出して、Sheet２を添付画像右側のようにしたいです。マーカーは不要です。

No.5 ベストアンサー 回答者： ぐーるぐる 回答日時： 2018/11/13 16:43

データを抜き出すだけで、関数が必要なければ、

タイトルつけて、フィルタリングして、必要なデータだけ抜き出すのが一番簡単かと思います(^_-)-☆

この回答へのお礼

実際にやってみて、すぐにできました。簡潔で分かりやすい説明でした。ありがとうございました。

お礼日時：2018/11/14 07:31

No.6 回答者： tom04 回答日時： 2018/11/13 16:48

こんにちは！

一番簡単なのは1行目を項目行にしておけば、オートフィルタでA列の「JP」をキーにフィルタを掛け
表示されているデータをそのまま別シートにコピー＆ペーストする方法だと思います。

別案としてVBAでの一例です。
元データはSheet1にあり、Sheet2に表示するとします。
ALT＋F11キー　→　メニュー　→　挿入　→　標準モジュール　→　VBE画面のカーソルが点滅しているところに
↓のコードをコピー＆ペースト　→　Excel画面に戻り（VBE画面を閉じて）マクロを実行してみてください。
（ALT＋F8キー　→　マクロ　→　マクロ実行です。）

Sub Sample1() '//この行から//
　Dim myDic As Object
　Dim i As Long, lastRow As Long
　Dim myStr As String, wS As Worksheet
　Dim myKey, myR, myAry
　　Set myDic = CreateObject("Scripting.Dictionary")
　　Set wS = Worksheets("Sheet2")
　　　wS.Range("A:C").ClearContents
　　　With Worksheets("Sheet1")
　　　　lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
　　　　myR = Range(.Cells(1, "A"), .Cells(lastRow, "C"))
　　　　　For i = 1 To UBound(myR, 1)
　　　　　　If myR(i, 1) = "JP" Then
　　　　　　　myStr = myR(i, 1) & "_" & myR(i, 2) & "_" & myR(i, 3)
　　　　　　　　If Not myDic.exists(myStr) Then
　　　　　　　　　myDic.Add myStr, ""
　　　　　　　　End If
　　　　　　End If
　　　　　Next i
　　　End With
　　myKey = myDic.keys
　　　myR = Range(wS.Cells(1, "A"), wS.Cells(UBound(myKey) + 1, "C"))
　　　　For i = 0 To UBound(myKey)
　　　　　myAry = Split(myKey(i), "_")
　　　　　　myR(i + 1, 1) = myAry(0)
　　　　　　myR(i + 1, 2) = myAry(1)
　　　　　　myR(i + 1, 3) = myAry(2)
　　　　Next i
　　　Range(wS.Cells(1, "A"), wS.Cells(UBound(myKey) + 1, "C")) = myR
　　　　Set myDic = Nothing
　　　　wS.Activate
　　　　MsgBox "完了"
End Sub '//この行まで//

※　コードは長いですが、数万行のデータがあっても
ほとんど時間を要しないはずです。m(_ _)m

No.4 回答者： mike_g 回答日時： 2018/11/13 15:30

添付図参照

No.3 回答者： fujillin 回答日時： 2018/11/13 15:30

こんにちは

関数で解決する方法とマクロで行う方法とが考えられます。
ひとまず、関数の方を・・・

Sheet2のA1セルに
=IFERROR(INDEX(Sheet1!A:A,SMALL(IF(Sheet1!$A$1:$A$1000="JP",ROW($A$1:$A$1000)),ROW(A1))),"")
の式を入れて、Shift+Ctrl+Enterで確定。（←必須です）
確定後、必要な範囲に（右、下へ）フィルコピー。

・・・で、できると思います。
（↑の式は、ひとまず1～1000行までを対象にしてあります）


※ マクロの例は、どなたかが回答してくれるのをお待ちください。

No.2 回答者： chonami 回答日時： 2018/11/13 15:22

色付けの方法を聞いている訳ではないので条件付き書式は全く関係ないですね。

私なら項目名をつけてフィルタオプションでやると思います。

No.1 回答者： たかしに 回答日時： 2018/11/13 15:03

条件付き書式でルールを設定すれば出来ます。