こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

重複行を完全削除するエクセルのマクロ

Sub sakujyo()
Dim i, ii As Long
For i = 1 To Range("a65336").End(xlUp).Row
For ii = Range("a65336").End(xlUp).Row To i + 1 Step -1
If Cells(i, 2).Value = Cells(ii, 2).Value _
And Cells(i, 4).Value = Cells(ii, 4).Value _
And Cells(i, 5).Value = Cells(ii, 5).Value Then
Dim iii As Byte
iii = 1
Rows(ii).Delete Shift:=xlUp
End If
Next ii
If iii = 1 Then Rows(i).Delete Shift:=xlUp
iii = 0
Next i
End Sub

データーが下の表のように入っております。
    A    B    C    E    F
1  1/26  a1234  fdsa  5000  C1
2  1/27  a4567  sdfa  4000  T2
3  1/28  a1234  dfsa  5000  C1
4  1/30  b4567  asdf  6600  A2
5  2/10  b4567  fsda  6600  A2
6  2/10  a1234  afds  5000  C1

B列、E列、F列が完全一致(重複1行目と3行目と6行目・4行目と5行目)で削除し結果的に2行目だけ残る方法がしたいのですが、このマクロですと少ないデータですとうまく動くのですが、『大量のデータを一気に削除出来ない』、『同じ重複が3つ以上のデータが多数ある場合データが削除されずに残ってしまう』エラーが出てしまいます。どうかお教えください。

投稿日時 - 2009-03-23 06:43:03

QNo.4819916

困ってます

質問者が選んだベストアンサー

シート1のデータをシート2に書き出します。
D列については不明ですが、B・E・F列の重複を判定しています。

書き出し結果と速度に問題があるか、ブックをバックアップしてから試してみて下さい。

Sub try()
 Dim myDic As Object
 Dim i As Long, j As Long
 Dim m As Long, st As String
 Dim v, vv

 Set myDic = CreateObject("Scripting.Dictionary")

 With Worksheets("Sheet1")
      v = .Range(.Range("A1"), .Cells(Rows.Count, 1).End(xlUp).Resize(, 6))
      For i = 1 To UBound(v, 1)
          st = v(i, 2) & "_" & v(i, 5) & "_" & v(i, 6)
          myDic(st) = myDic(st) + 1
      Next
 End With

 ReDim vv(1 To 6, 1 To 1)
 j = 1

 For i = 1 To UBound(v, 1)
     st = v(i, 2) & "_" & v(i, 5) & "_" & v(i, 6)
     If myDic(st) = 1 Then
        For m = 1 To 6
            vv(m, j) = v(i, m)
        Next
        j = j + 1
        ReDim Preserve vv(1 To 6, 1 To j)
     End If
 Next

 With Worksheets("Sheet2")
      .Range("A1").Resize(j - 1, 6).Value = _
      Application.Transpose(vv)
      .Range("A:A").NumberFormatLocal = "m/d"
 End With

 Set myDic = Nothing
 Erase v, vv
End Sub

ご参考になれば。

投稿日時 - 2009-03-23 07:44:22

お礼

すばやい対応ありがとうございます。
問題は、ございませんでした。とても早く動いたため驚いております。
大変助かりましたありがとうございます。また、機会がございましたら宜しくお願いいたします。

投稿日時 - 2009-03-23 14:34:36

ANo.1

このQ&Aは役に立ちましたか?

2人が「このQ&Aが役に立った」と投票しています

回答(4)

ANo.4

No2の回答と同意見になってしまうのですが、

マクロで重複検査を実施するよりもCOUNTIFで重複チェックを行う方が容易かと思われます。
G列に
=B1&E1&F1
H列に
=COUNTIF(H$1:H1,H1)
でオートフィルターでH列を1以外で指定し残っている行を削除。

複数のシートにマクロで対応する必要があるのであれば
H列を調べて1以外の行を削除する部分だけマクロ化すれば簡単に作成できると思いますよ。

投稿日時 - 2009-03-23 11:42:16

ANo.3

#2です。訂正だけ。

誤り> I列2行め以下 =IF(COUNTIF($H$1:$H$10000,H2),"Del",0)

I列2行め以下 =IF(COUNTIF(H$1:H1,H2),"Del",0)

失礼いたしました。

投稿日時 - 2009-03-23 09:02:36

お礼

勉強になりましたありがとうございます。

投稿日時 - 2009-03-23 14:38:21

ANo.2

こんにちは

初見での印象だけで書きますが、
VBAのコードにも問題はあるようですが、それ以前に、
なぜ手作業でやらないのでしょうか?
VBAの学習が目的とも思えないし、手作業の方が早く片付くような気がします。
(本稿は着想のままExcelがない環境で書いてますからヒント程度に)

///
作業セルを2列(仮にH列とI列)用意して、
 H列 =B1&":"&E1&":"&F1
 I列2行め以下 =IF(COUNTIF($H$1:$H$10000,H2),"Del",0)
のように数式を配置して、
I列に対してジャンプ機能(数式 文字列)で削除対象を選択、
(必要ならソートを挟む)とか。
///

マクロを作るにしても、
ExcelにできることはExcelにやらせる、方法を排除したら、
VBAである意味もないように思います。
マクロの記録でも少し手を加えるだけで十分なものが得られるでしょうし。

マクロを考える際、
 「最終的にExcelの機能(この場合は行削除のこと)を使う」処理で
 「条件づけ(検索)にExcelの機能が使える」
ならば、
基本的にExcelの機能を軸に作成することをお奨めします。
 エラーを出さずに大量のデータを一括処理・・・Excelが得意なことですよね?
その上で、不足が出たなら、また別の方法を考えればよいのかと。

VBAの質問と括らない方が有益な回答が得られるように私には思えました。

意図から外れているようでしたらスミマセン。
なお、本スレッドに対して、これ以上書くつもりはないので、悪しからず。

投稿日時 - 2009-03-23 08:24:29