【EXCEL VBA（マクロ）】縦（行）ループして、重複データを抽出して新規シートに貼り付ける

重複セル全て抽出して新規シート抽出

これはExcelシート内で特定のキーワードを含むセルを検索し、見つかったすべてのセルを強調表示し、コピーして新しいシートに貼り付けるエクセルマクロです。

流れ（概要）

ユーザーに検索するセルを選択するように求める
指定されたセルに対して部分一致検索を行い、ヒットした最初のセルを取得する
最初のヒット結果をもとに、FindNextメソッドを用いて全てのヒット結果を取得する
ヒットしたセルが含まれる行全体を新しいシートにコピーする
処理終了を知らせるメッセージボックスを表示する

Sub 検索セルを選択して重複セル全て抽出して新規シート抽出()   
  Dim fnd As Range
  Dim fnd_all As Range  
  Dim adr As String       

  Cells.ClearFormats
  
  'Findメソッドを用いて数値の検索を行う
    Dim key As String   
    Dim rng As Range   
    
    'ユーザーから検索キーを取得する
    key = Application.InputBox("検索するセルを選択")  
    If key = "False" Then   
        MsgBox ("キャンセルされました")
        Exit Sub
    End If
  

  Set fnd = ActiveSheet.Cells.Find(What:=key, LookAt:=xlPart) 
    If fnd Is Nothing Then
        MsgBox "見つかりませんでした。"
        Exit Sub
    Else
        Set fnd_all = fnd
        adr = fnd.Address
    End If

  Do
    DoEvents
    Set fnd = Cells.FindNext(After:=fnd)
        If fnd.Address = adr Then
            Exit Do
        Else
            Set fnd_all = Union(fnd_all, fnd)
        End If
  Loop
  
fnd_all.EntireRow.Interior.Color = RGB(204, 255, 255)  'fnd_all.EntireRow.Select


fnd_all.EntireRow.Copy
 Worksheets.Add(After:=ActiveSheet).Name = ActiveSheet.Name & "_" & VBA.Format(Now(), "h時mm分ss秒")
ActiveSheet.Paste
Range("A1").Select

MsgBox "完了： " & fnd_all.Row & " 件"  
End Sub

解説

2行目から3行目は、 fnd と fnd_all という2つの変数を宣言します。 fnd は、 Find メソッドで検索された最初のセルを格納します。 fnd_all は、 fnd と Union 関数を使用して見つかったすべてのセルを格納します。 adr 変数は、最初に見つかったセルのアドレスを格納します。

5行目から13行目は、 InputBox 関数を使用して、ユーザーから検索するキーワードを入力するように求めます。ユーザーがキャンセルボタンをクリックすると、プログラムが終了します。

15行目から20行目は、最初に見つかったセルを検索するために Find メソッドを使用します。キーワードが見つからなかった場合、プログラムはメッセージボックスを表示し、終了します。キーワードが見つかった場合、 fnd_all 変数に最初に見つかったセルを割り当てます。また、 adr 変数に最初に見つかったセルのアドレスを割り当てます。

22行目から30行目は、 FindNext メソッドを使用して、最初に見つかったセル以外のすべてのセルを検索するためのループです。 FindNext メソッドが最初に見つかったセルのアドレスに戻った場合、ループを終了します。それ以外の場合、 Union 関数を使用して、見つかったすべてのセルを fnd_all 変数に追加します。

32行目は、見つかったすべてのセルの行全体をライトブルーの背景色に変更します。

34行目から36行目は、 fnd_all 変数に格納されているすべてのセルを新しいシートにコピーして貼り付けるためのコードです。 Worksheets.Add メソッドを使用して新しいシートを作成し、コピーした行を貼り付けます。新しいシートの名前には、元のシート名と現在の時刻が含まれます。

使用しているVBA関数・オブジェクト・メソッド

Rangeオブジェクト：特定のセルや範囲を表します。
Cellsオブジェクト：Excelシート上のセルを表します。
Findメソッド：部分一致検索を行い、ヒットした最初のセルを取得します。
FindNextメソッド：前回の検索結果の次にヒットしたセルを取得します。
Union関数：複数のセルや範囲を結合します。
EntireRowプロパティ：指定されたセルが含まれる行全体を表します。
Copyメソッド：セルや範囲をコピーします。
Worksheetsオブジェクト：Excelファイル内の全てのシートを表します。
Addメソッド：新しいシートを作成します。
Afterプロパティ：指定されたシートの後ろに新しいシートを挿入します。
Nameプロパティ：シートの名前を設定します。
Format関数：日付や時間などの形式を変換します。
MsgBox関数：メッセージボックスを表示します。

ダミーデータのダウンロード

Dummy17 ダウンロード

【マクロ・VBA】縦（行）ループして、重複データを抽出して新規シートに貼り付ける