エクセルのマクロで重複データの削除

質問

横17列、縦、約1000行の表があります。
４行目が項目で、５行目以降は次のように並んでいます。

A列（日付）、B列～H列（各データ）　I列（契約番号）J列～Q列（各データ）

縦の並び順は、ばらばらで、日付順ではありません。しかも結構重複があります。
そこで、I列の商品番号をキーにして、重複をチェックし、重複しているものは、日付が新しいものを生かし、古い方は削除しようと思います。
しかし、手作業でやるにはあまりに多すぎるため、出来ればマクロでやりたいのですが、このように高度なものは、わたしが出来るマクロの記録程度では手におえそうもありません。
どのようにやったらよいのかどなたかお教え願えませんでしょうか？

回答No.6

noname#29107 · ベストアンサー

＃３です。また訂正です。すみません。

sub dupdlt
Dim Wsht1 As Worksheets
Dim MxRw As Long

set Wsht1 = Worksheets("Sheet1")
'↑Sheet1を実際ののシート名に変更
MxRw = Wsht1.Range("A65535").End(xlUp).Row
Wsht1.Range("A4:Q" & MxRw).Sort _
　　Key1:=Wsht1.Columns("I"), order1:=xlAscending, _
　　Key2:=Wsht1.Columns("A"), order2:=xlDescending, _
　　Header:=xlYes

For ix = MxRw To 6 Step -1
　　If Wsht1.Cells(ix, 9) = Wsht1.Cells(ix - 1, 9) Then
　　　　'Debug.Print ix & "行削除 " & Wsht1.Cells(ix, 1) & Wsht1.Cells(ix, 9)
　　　　Wsht1.Cells(ix, 9).EntireRow.Delete
　　End If
Next ix
End sub

お礼

ありがとうございました。

Dim Wsht1 As Worksheetsを
Dim Wsht1 As Worksheetに変えてうまくいきました。いいですよね？

回答No.7

nagare

失礼しました　デバグ済です

Private Sub CommandButton1_Click()

Dim lNowL As Long
Dim lLastL As Long
Dim lLastC As Long
Dim lDelC As Long

lNowL = 1
lLastL = 20
lLastC = 17
lDelC = 9

With Sheet1
.Range(.Cells(1, 1), .Cells(lLastL, lLastC)).Sort _
Key1:=.Cells(1, lDelC), _
Key2:=.Cells(1, 1), _
Order1:=xlAscending, _
Order2:=xlAscending, _
Header:=xlGuess
End With

While lNowL <= lLastL
With Sheet1
If lNowL <> lLastL Then
If .Cells(lNowL, lDelC).Value = .Cells(lNowL + 1, lDelC).Value Then
.Rows(lNowL & ":" & lNowL).Delete Shift:=xlUp
lLastL = lLastL - 1
Else
lNowL = lNowL + 1
End If
Else
lNowL = lNowL + 1
End If
End With
Wend

End Sub

お礼

なんどもありがとうございます。

回答No.5

mshr1962

#1のmshr1962です。
>１．「抽出先」とは「選択範囲内」と「指定した範囲」のどちらをチェックするのですか？
選択範囲内はオートフィルタと同じ様に非表示の設定
指定した範囲は別のセルに書き出しを行います。

>２．「リスト範囲」と「検索条件範囲」の違いはなんですか？
リスト範囲は元の表の範囲（１行目は項目）
検索条件範囲は別のシート等に抽出する条件を設定

下記URLをご覧ください。
【詳細な検索条件を指定してリストのデータを抽出する】
http://office.microsoft.com/ja-jp/assistance/HP052001781041.aspx
【重複しないレコードを抽出する】
http://office.microsoft.com/ja-jp/assistance/HP030734251041.aspx

お礼

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

回答No.4

noname#29107

＃３です。コードミスしてました。
正しくは、

sub dupdlt
Dim MxRw As Long
MxRw = Range("A65535").End(xlUp).Row
Range("A4:Q" & MxRw).Sort _
　　Key1:=Worksheets("Sheet2").Columns("I"), order1:=xlAscending, _
　　Key2:=Worksheets("Sheet2").Columns("A"), order2:=xlDescending, _
　　Header:=xlYes

For ix = MxRw To 6 Step -1
　　If Wsht1.Cells(ix, 9) = Wsht1.Cells(ix - 1, 9) Then
　　　　'Debug.Print ix & "行削除 " & Wsht1.Cells(ix, 1) & Wsht1.Cells(ix, 9)
　　　　Wsht1.Cells(ix, 9).EntireRow.Delete
　　End If
Next ix
End sub

回答No.3

noname#29107

普通にマクロで記述するなら、
１）データを並び替え、I列昇順、A列降順
２）最下行から上に重複データを削除
のような感じにするのが一般的です。

具体的にはこんな感じです。テストしてないので、実際に使用される場合は、十分注意してください。

sub dupdlt
Dim MxRw As Long
MxRw = Range("A65535").End(xlUp).Row
Range("A4:Q" & MxRw).Sort _
　　Key1:=Worksheets("Sheet2").Columns("I"), order1:=xlAscending, _
　　Key2:=Worksheets("Sheet2").Columns("A"), order2:=xlDescending, _
　　Header:=xlYes

For ix = MxRw To 6 Step -1
　　If Wsht1.Cells(ix, 2) = Wsht1.Cells(ix - 1, 2) Then
　　　　'Debug.Print ix & "行削除 " & Wsht1.Cells(ix, 1) & Wsht1.Cells(ix, 9)
　　　　Wsht1.Cells(ix, 9).EntireRow.Delete
　　End If
Next ix
End sub

回答No.2

nagare

バグがあったらごめんさい
これでOKだと思います
また、最終列、最終行の自動取得も可能ですが必要ですか？

★SORT(I列は11です)

With シート名
.Range(.Cells(1, 1), .Cells(最終行, 17)).Sort _
Key1:=.Cells(1, 11), _
Key2:=.Cells(1, 1), _
Order1:=xlAscending, _
Order2:=xlAscending, _
Header:=xlGuess
End With

★削除(I列は11です)
現在行 = 1
While 現在行 <= 最終行
With シート名
If 現在行 <> 最終行 Then
If .Cells(現在行, 11).Value = .Cells(現在行 + 1, 11).Value Then
.Rows(現在行 & ":" & 現在行).Delete Shift:=xlUp
最終行 = 最終行 - 1
End If
End If
End With
現在行 = 現在行 + 1
Wend

お礼

ありがとうございます。

やってみましたら、三重複（３つ同じ）は一つしか削除されないようです。

補足

I列は11ではないですよ。

回答No.1

mshr1962

フィルタオプションの設定を使われたら如何ですか？
「データ」「フィルタ」「フィルタオプションの設定」で
「重複するレコードは無視する」にチェックしてOKで
重複した行を非表示にした状態になります。

これをコピーして別シートに貼り付けるなり
フィルタオプションの設定で別の場所に抽出するなりすればいいと思います。

上記の設定のマクロ化もマクロの記録でできると思いますが．．．

補足

早速ありがとうございます。

オートフィルターなら使ったことはありますが、フィルターオプションと言うのは初めてなのでわからないことだらけです。

「データ」「フィルタ」「フィルタオプションの設定」で

１．「抽出先」とは「選択範囲内」と「指定した範囲」のどちらをチェックするのですか？

２．「リスト範囲」と「検索条件範囲」の違いはなんですか？

やってみたら全てが非表示になってしまいました。