Excelで特定の文字列を含む行を自動的に抽出して別シートにコピーするマクロの作り方#0008

VBA

Excelのデータ処理では、特定の文字列を含む行を別シートに抽出したいときがあります。手動でこの作業を行うのは手間がかかりますが、VBAマクロを使えば簡単に自動化ができます。この記事では、特定の文字列を含む行を抽出して別シートにコピーするマクロの作り方を解説します。

ボールペンでヒットした行を新しいシートに行コピーする

コピー元シートのB列のボールペンを検索し、ヒットした行を抽出データシートに行ごとコピーをするというVBAマクロです。

Sub 特定の文字列を含む行を抽出()
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim targetRow As Long
    Dim cellValue As String

    ' シートの設定
    Set sourceSheet = ThisWorkbook.Sheets("コピー元")
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("抽出データ").Delete ' 既に存在する場合は削除
    Application.DisplayAlerts = True
    On Error GoTo 0
    Set targetSheet = ThisWorkbook.Sheets.Add
    targetSheet.Name = "抽出データ"

    ' 元シートの最終行を取得
    lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "B").End(xlUp).Row

    targetRow = 1

    ' ヘッダーをコピー
    sourceSheet.Rows(1).Copy Destination:=targetSheet.Rows(1)
    targetRow = targetRow + 1

    ' 列Bのデータをループ(2行目から検索)
    For i = 2 To lastRow
        cellValue = CStr(sourceSheet.Cells(i, 2).Value) ' 列Bを文字列として扱う
        cellValue = Trim(Replace(cellValue, " ", ""))  ' 全角スペース削除(全角対応)

        ' 完全一致
        If cellValue = "ボールペン" Then
            sourceSheet.Rows(i).Copy Destination:=targetSheet.Rows(targetRow)
            targetRow = targetRow + 1
        End If
    Next i

    ' コピーしたデータの列幅を調整
    targetSheet.Columns.AutoFit

    MsgBox "完全一致でデータの抽出が完了しました。", vbInformation, "完了"
End Sub

このマクロを使用するために、シート名を変更します。

Set sourceSheet = ThisWorkbook.Sheets("コピー元")

上記の箇所が特定文字のボールペンを検索している元シートになります。ご自身のエクセルに合わせ、”コピー元”の文言を修正する必要があります。

' 元シートの最終行を取得
    lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "B").End(xlUp).Row

上記のRows.Count, “B” このBの箇所を特定文字を検索したい列にします。今回は商品名のボールペンを検索文字として利用したいため、B列になります。

 ' 完全一致
        If cellValue = "ボールペン" Then

上記の箇所で特定文字の設定をしています。今回は、B列のボールペンに該当した行を抽出したいため、”ボールペン”と入力してあります。

targetSheet.Name = "抽出データ"

上記の”抽出データ”の箇所を抽出した行を反映したいシート名に修正をします。

Sheets("抽出データ").Delete ' 既に存在する場合は削除

同様に上記も抽出した行を反映したいシート名に修正をします。

マクロ実行後は、コピー元シートで、ボールペンとヒットした行を、抽出シートに行ごとコピーするということが簡単に出来ます。

Excelセル入力で検索文字・列に対応させる

次に、先ほどのVBAマクロを覚えたものの、毎回検索したい文字が変わる。そんなケースを想定し、検索文字、検索列というセルを実装します。

Sub 特定の文字列を含む行を抽出()
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim targetRow As Long
    Dim cellValue As String
    Dim searchColumn As String
    Dim searchString As String
    Dim colNumber As Long

    ' シートの設定
    Set sourceSheet = ThisWorkbook.Sheets("コピー元")

    ' 検索条件をE7・E8セルから取得
    searchColumn = sourceSheet.Range("E7").Value   ' 検索列(例: "B")
    searchString = sourceSheet.Range("E8").Value   ' 検索文字(例: "ボールペン")
    colNumber = sourceSheet.Range(searchColumn & "1").Column ' 列番号に変換

    ' 抽出シートを再作成
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("抽出データ").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    Set targetSheet = ThisWorkbook.Sheets.Add
    targetSheet.Name = "抽出データ"

    ' 元シートの最終行を取得(検索列の最終行)
    lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, colNumber).End(xlUp).Row

    targetRow = 1

    ' ヘッダーをコピー
    sourceSheet.Rows(1).Copy Destination:=targetSheet.Rows(1)
    targetRow = targetRow + 1

    ' データをループ(2行目から検索)
    For i = 2 To lastRow
        cellValue = CStr(sourceSheet.Cells(i, colNumber).Value) ' 検索列の値
        cellValue = Trim(Replace(cellValue, " ", ""))          ' 全角スペース削除

        ' 完全一致判定
        If cellValue = searchString Then
            sourceSheet.Rows(i).Copy Destination:=targetSheet.Rows(targetRow)
            targetRow = targetRow + 1
        End If
    Next i

    ' 列幅を自動調整
    targetSheet.Columns.AutoFit

    MsgBox "完全一致で [" & searchColumn & "] 列から '" & searchString & "' を抽出しました。", vbInformation, "完了"
End Sub

汎用性をもたらすためには、コピー元シートのE7セル、E8セルを検索用の検索列と検索文字というような欄を設けます。

' 検索条件をE7・E8セルから取得
    searchColumn = sourceSheet.Range("E7").Value   ' 検索列(例: "B")
    searchString = sourceSheet.Range("E8").Value   ' 検索文字(例: "ボールペン")

上記のようにVBAコードを書き換えることで、エクセルE7セルに入力した列、エクセルE8セルに入力した文字を検索対象とすることが可能です。

ダイアログを使用し検索文字や列を抽出する

先ほどは、Excelのセルを使用し、検索したい文字や列を指定しましたが、今度は、さらに汎用性がきくように、ダイアログで検索したい文字や列を指定してみます。

Sub 特定の文字列を含む行を抽出_ダイアログ()
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim targetRow As Long
    Dim cellValue As String
    Dim searchColumn As String
    Dim searchString As String
    Dim colNumber As Long

    ' シートの設定
    Set sourceSheet = ThisWorkbook.Sheets("コピー元")

    ' ダイアログで検索条件を取得
    searchColumn = InputBox("検索対象列を入力してください(例: A, B, C...)", "検索列指定", "B")
    If searchColumn = "" Then Exit Sub  ' キャンセル時は終了

    searchString = InputBox("検索文字列を入力してください", "検索文字指定", "ボールペン")
    If searchString = "" Then Exit Sub  ' キャンセル時は終了

    colNumber = sourceSheet.Range(searchColumn & "1").Column ' 列番号に変換

    ' 抽出シートを再作成
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("抽出データ").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    Set targetSheet = ThisWorkbook.Sheets.Add
    targetSheet.Name = "抽出データ"

    ' 元シートの最終行を取得(検索列の最終行)
    lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, colNumber).End(xlUp).Row

    targetRow = 1

    ' ヘッダーをコピー
    sourceSheet.Rows(1).Copy Destination:=targetSheet.Rows(1)
    targetRow = targetRow + 1

    ' データをループ(2行目から検索)
    For i = 2 To lastRow
        cellValue = CStr(sourceSheet.Cells(i, colNumber).Value)
        cellValue = Trim(Replace(cellValue, " ", ""))  ' 全角スペース削除

        ' 完全一致
        If cellValue = searchString Then
            sourceSheet.Rows(i).Copy Destination:=targetSheet.Rows(targetRow)
            targetRow = targetRow + 1
        End If
    Next i

    ' 列幅を自動調整
    targetSheet.Columns.AutoFit

    MsgBox "完全一致で [" & searchColumn & "] 列から '" & searchString & "' を抽出しました。", vbInformation, "完了"
End Sub

VBAマクロを実行すると、ダイアログで検索列を指定します。今回は商品名でB列を指定したいため、Bと入力します。

次に検索文字列として、ボールペンに該当する1行を抽出したいため、ボールペンと入力します。

実行結果として、抽出データシートにボールペンに該当した1行が反映されます。

まとめ

いかがでしたでしょうか。この記事では、Excelで特定の文字列を含む行を自動的に抽出して別シートにコピーするマクロのご紹介。また、汎用性をもたらすために、検索列、検索文字という欄をエクセル表に設け、毎回変わる検索文字に対応する方法、そして、検索列と検索文字の欄をエクセル表に作るのではなく、ダイアログとして、マクロ実行時にウィンドウで検索列や検索文字を決める方法の3つをご紹介しました。

コメント

タイトルとURLをコピーしました