Excel VBA 一覧に一致する行をコピーして出力する方法

どうも、カネスズです。

今回はタイトル通り、「一覧に一致する行をコピーして出力する」マクロをVBAで組んで

見たので紹介したいと思います。

と言っても、私は現在VBAの勉強中なので不具合が出るかもしれませんが、ご了承ください。

※今回はソースと使用例の紹介のみです。ソースの解析はまた別記事で行います。

スポンサードリンク

用途

このマクロを組もうと思ったきっかけは、仕事で資料の作成を頼まれたのですが

手作業では時間がかかりすぎる!!

そう判断し、マクロ化することにしました。

仕事の内容としては

「この一覧にある値に一致する値があれば、そのデータをコピーして

新しい一覧を作ってちょ」

というものでした。

これだけでは分からないと思うので、図解します。

まずは検索する値です。

次に比較値をもとにして探すデータ一覧です。

つまり、比較値「aaa、bbb~」をデータ一覧のA列から探し出しそのデータを

新しいシートに出力するということですね。

例として出したものはデータ数が10件ほどしかないからいいものの

実際は1000件以上の中から対象となるデータを探し出し、

抜き出すという面倒臭いものです。

手作業じゃやってられないですよね…

という訳で、実際にマクロを組んだのでご覧ください。

スポンサードリンク

ソースコード

↓がソースコードです。

こいつをそのまま張り付けてもうまく動かないと思うので、

注意点を記載しておきます。


Sub search()
    
    '対象とするシートの宣言
    
    '検索値があるシート
    Dim targetSheet As Worksheet
    '対象データがあるシート
    Dim seathSheet As Worksheet
    '検索結果を出力するシート
    Dim outputSheet As Worksheet
    
    Set targetSheet = Worksheets(1)
    Set seathSheet = Worksheets(2)
    Set outputSheet = Worksheets(3)
    
    '比較値の最終行取得
    Dim row As Integer
    row = targetSheet.Cells(targetSheet.Rows.Count, 1).End(xlUp).row
    '出力行数
    Dim cnt As Integer: cnt = 2
    
    For i = 2 To row
        '検索結果のセル
        Dim foundCell As Range
        '検索値のセル
        Dim searthCell As Range
        
        Set searthCell = targetSheet.Cells(i, 1)
        '検索値が空白ならスキップ
        If Not searthCell = "" Then
            '検索結果取得
            Set foundCell = seathSheet.Cells.Find(searthCell, LookAt:=xlWhole, SearchOrDer:=xlByColumns)
           
            '検索結果が得られなかった場合スキップ
            If Not foundCell Is Nothing Then
               Set FirstCell = foundCell

               Do
                 '比較値に一致した一覧の行をコピー
                 seathSheet.Rows(foundCell.row).Copy
                 '結果シートに張り付け
                 outputSheet.Rows(cnt).PasteSpecial (xlPasteValues)
                 '結果シートへ張り付ける行を変更するためプラス1
                 cnt = cnt + 1
                 '次を検索
                 Set foundCell = seathSheet.Cells.FindNext(foundCell)
                 
                 '次の検索が最初と同じor存在しなかった場合次の検索値へ
                 If foundCell.Address = FirstCell.Address Then
                     Exit Do
                 ElseIf foundCell Is Nothing Then
                     Exit Do
                 End If
            Loop
                
            End If
        End If
    Next
    
End Sub

注意点1:対象シートは同じブックに置くこと

「検索値があるシート」、「データがあるシート」、「検索結果を出力するシート」は

同じブックにおいてください。

置き方も重要で

↑の様な順番で配置してください。

注意点2:比較値はA列に置くこと

↓と同じ形式なら問題ないと思います。

実行結果

実行した結果はこちらです。

最初の実行結果と同じ内容ですね。

これにて完了!!

依頼された資料作成もばっちりでした。

おわりに

実際の業務で今回の様な仕事を依頼されることは結構あると思いますが、

VBAが使えると本当に便利ですよね。

今回紹介したマクロをそのまま使ってもいいとは思いますが、

動作は保証しかねますので、自己責任でお願いします。

一番理想的なのは、自分でしっかり理解してマクロを組めればGoodです。

紹介したマクロが参考になれば幸いです。

スポンサードリンク

シェアする

フォローする