EXCEL VBAの重複行削除について
- EXCEL VBAを使用している場合に、重複する行を削除する方法を教えてください。
- RemoveDuplicatesを使用して行の重複を削除するコードを組んだ場合、古いデータが残ってしまう問題が発生します。
- 欲しいデータの表のように、日付の新しいものを残すように重複行削除する方法があれば教えてください。
- ベストアンサー
EXCEL VBAの重複行削除について
EXCEL2010を使用しています。 添付画像の「重複行削除 前」の表を、RemoveDuplicatesで下の様にコードを組んで A列で重複する行を見て重複する行を削除しています。 Public Sub 重複行削除() With WorkSheets(1) .Range(.Cells(1, 1), .Cells(8, 3)).RemoveDuplicates _ Columns:=1, Header:=xlYes End With End Sub すると、日付の新しいデータが削除され、古いデータが残ってしまいます。 (添付画像の「重複行削除 後」) ReniveDuplicates Columns:=Array(1,3) とした場合は、すべてのデータが残ってしまいます。 添付画像の「欲しいデータ」の表の様に、 日付の新しいものを残すように重複行削除は出来ないでしょうか? 詳しい方、どうか教えてください。 よろしくお願いします。
- KK4016
- お礼率85% (12/14)
- Excel(エクセル)
- 回答数2
- ありがとう数2
- みんなの回答 (2)
- 専門家の回答
質問者が選んだベストアンサー
RemoveDuplicates メソッドに、削除の優先(指定)順序を記述するパラメータ(引数)がない以上)、あれこれ考えても、ここに質問しても、無駄でしょう。RemoveDuplicatesメソッドでは、あとに残る1データは、最初行か最終行のどちらかにちがいないのだから、逆手に取ってデータを残すほうにデータ順序を持って行っておく(変えておく)しかないだろう。 その方法を取るかまたは、このメソッドを使わず、優先キー(重複を考えている項目)+日付でソートして、 (1)CountIF的な判別法で2になった行は削除 (2)重複を考える項目で、ソートしておいて、直前との同一を見る方法(第2以後の出現は削除)ー最初が残る などで重複を判定して、削除すればよい。 (1)では、ソートしておかないと、新しいものを残すロジックはむつかしい。 後者の2者比較で重複がわかったとき、日付を比較して、新しい(日付シリアル値的に大)法を残す手もある。(MAXやMINのレコードを見つけるロジックと同じ。) ーー 重複しているかどうかは最後のレコードまで読まないと判定できないのだから、ソートしておく方法(そこに処理時間を押しつける)が一番ロジック的に考えやすい。其の後は処理は一直線(レコード1読)で終わる。 この方法は昔からオフラインバッチ処理の常道なんだ。
その他の回答 (1)
- f272
- ベストアンサー率46% (7964/17024)
日付で逆順に並べ替えてから,重複行削除を削除する。 もし元の順に戻したいのなら,日付で逆順に並べ替える前に元の順序をあらわす列を挿入しておいてから,重複行削除を削除した後に,その列を使って元の順に戻す。
お礼
回答ありがとうございます。 元の順序も考えて、行挿入→ソート→重複行削除→ソート で考えたいと思います。
関連するQ&A
- エクセルVBAで表の重複行の削除
仮にB2:AA32の範囲の表の全列のデータが重複している行を削除する場合は以下のようなコードになると思います。 質問は、列の指定の=Array(1,~, 26)の部分をもっと簡略化する方法ことはできないかです。 ご教示ください。 ActiveSheet.Range("$B$2:$AA$32").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, _ 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26), Header:=xlYes
- ベストアンサー
- Excel(エクセル)
- マクロ 重複削除の選択範囲を全てにしたい
K列全てを選択し、重複削除をする流れをマクロ記録で作成しました。 コードはA1セルからS7731セルまでですが、毎回データの量が変わってしまうので、S7731セルまでではなく、全てにしたいですが、どうすればよいのですか? 宜しくお願いします。 Sub 重複削除() Columns("K:K").Select ActiveSheet.Range("$A$1:$S$7731").RemoveDuplicates Columns:=11, Header:= _ xlYes End Sub
- ベストアンサー
- Visual Basic
- エクセル マクロ(VBA) 空白&重複の削除
データの空白と重複を削除(上詰め)し、10行目から並べる というマクロを書きたいです。 下記のマクロを実行すると、添付の緑色のセルのように、 なぜか空白の部分ができてしまいます。 緑色の空白を詰めるには、どのように書けばよいでしょうか。 さらに、Sheet2のデータを元にマクロを実行した時に、そのデータは 変更せずに、結果をSheet3に表示したいのですが、その方法を教えて下さい。 (現在のマクロだと、実行元のデータがある同じシート内で整列されます。) - Sub macro1() Dim i As Long On Error Resume Next For i = 1 To 10 With Columns(i) .SpecialCells(xlCellTypeBlanks).Delete shift:=xlShiftUp .RemoveDuplicates Columns:=1, Header:=xlNo End With Next i Range("1:9").Insert shift:=xlShiftDown End Sub -
- ベストアンサー
- Excel(エクセル)
- VBA RemoveDuplicatesが動かない
以下のマクロを実行しても動きません。 RemoveDuplicatesの行でエラーとなります。 メッセージ:アプリケーション定義またはオブジェクト定義のエラーです。 何が間違ってるのでしょう? エクセル2013 Windows8 E列の重複を削除するマクロです。不要なWithを使っているのは、別マクロから切り出したものだからです。 Sub test() Dim Colref As Long, LastRow As Long With Worksheets("Sheet1") Colref = 5 LastRow = Cells(Rows.Count, Colref).End(xlUp).Row Range(.Cells(1, Colref), .Cells(LastRow, Colref)).RemoveDuplicates Columns:=CVar(Colref), Header:=xlNo End With End Sub
- ベストアンサー
- Excel(エクセル)
- 重複した値を一つ残す VBA
重複した値を一つだけ残していきたいです。 たとえば リンゴ リンゴ リンゴ とあれば2つリンゴが消えて欲しいです 今のところ重複した値を消す方法しかわからず詰まっています。 なにとぞよろしくおねがいします Option Explicit Sub test() Dim i As Double Dim x As Double Application.Calculation = xlCalculationManual Application.ScreenUpdating = False Range("T3", Range("T" & Rows.Count).End(xlUp)).Sort Key1:=Range("T3"), Order1:=xlAscending, Header:=xlYes For i = 3 To Cells(Rows.Count, 20).End(xlUp).Row Range(Cells(i, "T"), Cells(i, "T")).RemoveDuplicates Columns:=Array(1), Header:=xlYes Application.Calculate Next End Sub
- ベストアンサー
- Visual Basic
- 重複行を完全削除するエクセルのマクロ
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つ以上のデータが多数ある場合データが削除されずに残ってしまう』エラーが出てしまいます。どうかお教えください。
- ベストアンサー
- オフィス系ソフト
- vba エクセル
2行目から、最終行までEmptyにしたいのにならないです。 1行目はフィールド行なのに、そのままにしたいのですが 2行目から最終行は空白にしたいです。 なので Sub TEST() With Sheets("log") lastRow = .Cells(.Rows.Count, "b").End(xlUp).Row LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column .Range(.Cells(2, LastCol), .Cells(lastRow, LastCol)) = Empty End With End Sub としたのですが、何も起こりません。 lastRowは100、LastColは5なのですが、 このマクロを実行しても何も起こらないです。 なぜでしょうか?
- 締切済み
- Excel(エクセル)
- 重複行を完全削除するエクセルのマクロ
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, 4).Value = Cells(ii, 4).Value _ And Cells(i, 13).Value = Cells(ii, 13).Value Then Delete Shift:=xlUp End If Next ii Next i End Sub マクロに関しては、素人でございます。 こちらのマクロを作ってみたのですがうまくいきません。 4列目と13列目の列が重複したときのみ重複した行をすべて削除させたいと思っております。どうぞお教えください。
- ベストアンサー
- オフィス系ソフト
- 昇順
失礼します。昇順がうまくいかず困っています。 本来T3から下を昇順で並び変えたのち重複した値を削除したいのですがうまくいきません もしよろしければダメな点を教えていただけないでしょうか?よろしくおねがいします。 Option Explicit Sub test() Dim i As Double Dim x As Double For i = 3 To Cells(Rows.Count, 20).End(xlUp).Row Range(Cells(i, "T"), Cells(i, "T")).Sort Key1:=Range("T2"), Order1:=xlAscending, Header:=xlYes Range(Cells(i, "T"), Cells(i, "T")).RemoveDuplicates Columns:=Array(1), Header:=xlYes Next End Sub
- ベストアンサー
- Visual Basic
- 重複行削除のマクロ
重複行を削除するマクロを作っていますが、うまくいきません。 2行目にタイトルが入っていて、3行目以降が必要なデータになります。 この中でA列が一致しているデータ行を削除したいと考えており、 重複データが削除された後、タイトル行がなぜか一番下の行にはりついてしまいます。 どなたか詳しい方助けてください!!!よろしくお願いします。 ちなみに以下が現在使用しているVBAコードです。 =============================================================== Sub GoodRemoveDuplicates() 'A列にデータが入力されており、そのデータを並べ替えた後、 '重複するデータが含まれている行を削除するマクロ Worksheets("貼り付け用用マクロ").Range("A1").Sort _ key1:=Worksheets("貼り付け用用マクロ").Range("A1") Set currentCell = Worksheets("貼り付け用用マクロ").Range("A1") Do While Not IsEmpty(currentCell) Set nextCell = currentCell.Offset(1, 0) If nextCell.Value = currentCell.Value Then currentCell.EntireRow.Delete End If Set currentCell = nextCell Loop End Sub ===============================================================
- ベストアンサー
- Visual Basic
お礼
回答ありがとうございます。 ソートする方法で考えます。