• 締切済み

Excel VBAで値が重複する行を削除する

Excel2000を使っています。 シートAに数千件のデータがあります。 シートBのE列にある文字とシートAのD列の文字が重複する場合に、シートAの重複するセルがある行を削除する(且つできれば行のデータを抜き出すVBAを作ろうと考えています。 最近VBAの初心者本をやっと理解したところで、ちんぷんかんぷんとまではいかないけど、知恵熱がでました。 仕事なので自分でなんとかすべきかと思いますが、きっかけの調べ方がまずわからない。 どなたか、解かるきっかけだけでも与えて頂けないでしょうか。とくに、別シートの値と重複する値を探す場合に何をいれるかわかればきっと道は開けると思うんですが…。 初めての質問なので、質問内容が至らなかったらもうしわけありません。

みんなの回答

  • ka_na_de
  • ベストアンサー率56% (162/286)
回答No.3

こんばんは。 一例です。参考になれば幸いです。 一行目に見出し行があり、二行目からデータがある前提です。 また、重複行は「シートC」に抜き出します。 「シートC」はあらかじめ作成しておいてください。 未記入シートで結構です。 Sub test()   Dim Ws1 As Worksheet   Dim Ws2 As Worksheet   Dim Ws3 As Worksheet   Dim myWs1Rng As Range   Dim myWs2Rng As Range   Dim myCell As Range   Dim i As Long   Dim myAns As Variant      Set Ws1 = Worksheets("シートA")   Set Ws2 = Worksheets("シートB")   Set Ws3 = Worksheets("シートC")      Ws3.Cells.Clear      Set myWs1Rng = Ws1.Range("D2", Ws1.Cells(Rows.Count, "D").End(xlUp))   Set myWs2Rng = Ws2.Range("E2", Ws2.Cells(Rows.Count, "E").End(xlUp))      Application.ScreenUpdating = False      Ws1.Rows(1).Copy Ws3.Range("A1")   i = 2   For Each myCell In myWs1Rng     myAns = Application.Match(myCell.Value, myWs2Rng, 0)     If IsError(myAns) = False Then       myCell.EntireRow.Copy Ws3.Cells(i, "A")       myCell.EntireRow.Delete       i = i + 1     End If   Next myCell   Application.ScreenUpdating = True      Set Ws1 = Nothing   Set Ws2 = Nothing   Set Ws3 = Nothing   Set myWs1Rng = Nothing   Set myWs2Rng = Nothing   Set myCell = Nothing End Sub

  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.2

こんばんは。 ご質問のデータの位置関係が今ひとつ分からないけれども、数がいくらあっても、関数のCountIf と、オートフィルタを組み合わせて使えば、あまりマクロという手段にこだわらなくてもよいと思います。こういうアイデアを元にマクロを組み立てれば簡単に出来ます。 '------------------------------------------- Sub Test1()   Dim sh1 As Worksheet   Dim sh2 As Worksheet   Dim r1 As Range   Dim r2 As Range   Dim i As Long   Set sh1 = Worksheets("Sheet1")   Set sh2 = Worksheets("Sheet2")      With sh1 'シート1 のデータ     Set r1 = .Range("D1", .Range("D65536").End(xlUp))   End With   With sh2 'シート2 のデータ     Set r2 = .Range("E1", .Range("E65536").End(xlUp))   End With      With sh1     With r1        'E列に数式の貼り付け       .Offset(, 1).Formula = "=COUNTIF(" & sh2.Name & "!" & r2.Address(, , xlR1C1) & ",RC[-1])"       .Offset(, 1).Value = .Offset(, 1).Value     End With      'オートフィルタ用のヘッダ付け     .Rows(1).Insert     For i = 1 To 5 'E列まで      .Cells(1, i).Value = Chr(64 + i)     Next i     'オートフィルタ 重複の取り出し     r1.CurrentRegion.AutoFilter Field:=5, Criteria1:=">0"     '不要行の削除     Application.DisplayAlerts = False     .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Delete     Application.DisplayAlerts = True     'オートフィルタの解除     .AutoFilterMode = False     '抽出カウントの削除     r1.Columns(2).ClearContents   End With End Sub

  • rukuku
  • ベストアンサー率42% (401/933)
回答No.1

こんばんは 処理スピードを気にしないならば、 1.シートAのD1~D数千を一つずつチェックし、シートBのE1と一致した場合にはIV列に※をつける。 2.シートAのD1~D数千を一つずつチェックし、シートBのE2と一致した場合にはIV列に※をつける。 3.シートAのD1~D数千を一つずつチェックし、シートBのE3と一致した場合にはIV列に※をつける。 … とシートBにある行の数だけ実行します。 そのあとで、シートAのIV列に※が付いている行を削除すると、実現できます。 For to step ~ Next If ~ then の使い方に慣れてください。 また、データの入っている最終行を取得するには、 Cells(Rows.Count, "A").End(xlUp).Row が使えます。 書籍やホームページによっては、 [A65536].End(xlUp).Row と書かれていることもあると思います。 注:最終行にデータが入力されることはないという前提です。 >仕事なので自分でなんとかすべきかと思いますが、きっかけの調べ方がまずわからない。 私も、分からないことがあるとヘルプを見たり、インターネットで探したりします。詳細な機能について、具体的にどうすればいいのは結構見つかるものです。しかし、「どのようなプログラムを組めばいいのか」と言うのは、まず見つかりません。 こればかりは、色々と経験を重ねて身につけるしかないと思います。

関連するQ&A

専門家に質問してみよう